Skip to content

Instantly share code, notes, and snippets.

@cliffordp
Last active September 13, 2023 03:59
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save cliffordp/cf790e4e7e09eba624dbe98fa9005aad to your computer and use it in GitHub Desktop.
Save cliffordp/cf790e4e7e09eba624dbe98fa9005aad to your computer and use it in GitHub Desktop.
Rounds up to next (not nearest) $0.50
' Blank out all the Bonus column values, place your cursor in the Bonus column, then use this!'
Sub GoalSeekZeroOrPositiveOnEmptyCells()
Dim TargetRange As Range
Dim ChangingCell As Range
Dim CurrentCell As Range
' Loop through each cell in the current column
For Each CurrentCell In ActiveCell.CurrentRegion.Columns(ActiveCell.Column).Cells
' Check if the cell to the left is blank
If IsEmpty(CurrentCell.Offset(0, -1).Value) Then
Exit For ' Exit the loop if a blank cell to the left is found
End If
' Check if the cell is empty
If CurrentCell.Value = "" Then
' Set the changing cell to the current cell
Set ChangingCell = CurrentCell
' Set TargetRange to a cell in the same row and 8 columns to the right
Set TargetRange = CurrentCell.Offset(0, 8)
' Use error handling to catch any NA errors
On Error Resume Next
TargetRange.GoalSeek Goal:=0, ChangingCell:=ChangingCell
On Error GoTo 0 ' Reset error handling
' Check if an error occurred (Goal Seek didn't find a solution)
If Err.Number <> 0 Then
' Handle the error by setting the CurrentCell's value to zero
ChangingCell.Value = 0
Err.Clear ' Clear the error
ElseIf ChangingCell.Value < 0 Then
' Check if the Goal Seek result is less than zero, and set it to zero
ChangingCell.Value = 0
Else
' Round up the value in ChangingCell to the next $0.50
ChangingCell.Value = WorksheetFunction.Ceiling(CDbl(ChangingCell.Value), 0.5)
End If
End If
Next CurrentCell
Application.Calculate
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment