Round to nearest hundred, thousand etc. with VBA macros

You might need to round to the nearest 1000 (or whatever). It may be rounding 77 to 80, 315 to 400, 1777 to 2000 etc. On this page I show how to do it with a VBA macro.

The other day I needed the functionality for automatic scaling of a chart's Y axis. Selecting automatic scaling was no good, because the chart was animated, and it would look stupid, if the Y axis changed constantly as the bar grew higher.

I solved the problem by calculating the final value and scaling the Y axis before I started the loop-driven animation. The function rounding to nearest whole number (e.g. 70), 100, 1000 etc. follows below.

It would be simple if you always needed to round up to the nearest thousand. Then you could use the following code snippet, where I assume that the input value is 1777:

Rounded value = Fix(1777 / 1000) * 1000 + 1000

However it is not that simple, if the input value can be anything. Then you need a more robust code that will make a sensible scaling no matter if the value is 2, 77 or 18,374.37.

If you want to test the code just copy it into a VBA module. As it is a function, it returns a value and must be called from another function or procedure passing the input value.

Function NearestRoundValue(ByVal dInputVal As Double)

Dim lRoundVal As Long   'Rounded input value
Dim lFactor As Long     'Factor - ten, hundred, thousand etc.
Dim lValLenght As Long  'Number of digits in rounded value
Dim lLoop As Long       'Counter
Dim sNb As String       'String variable

On Error GoTo ErrorHandle

'First we round the input value, and to get
'the right number of digits if it is a negative
'value, we use tha Abs function.
lRoundVal = Round(Abs(dInputVal))

'Convert the rounded number to a string, trim
'for blanks and return the length - that is the
'number of digits. We subtract 1 to get the
'the right of zeroes that we will use later.
lValLenght = Len(Trim(Str$(lRoundVal))) - 1

'We now make the factor as a string by adding
'zero X times, where X = lValLength
sNb = "1"
For lLoop = 1 To lValLenght
   sNb = sNb & "0"
Next

'Convert the factor from a string to a number
lFactor = Val(sNb)

'We now find the nearest round number upwards.
'If you want to find the nearest round number
'(up- or downwards) just omit the last "+ lFactor).
'Instead of the Round function we use Fix that
'removes the decimal. If we used Round the
'following would return 90 if lRoundVal was 75
'and 80 if lRoundVal was 74. With Fix it will
'return 80 in both cases.
lRoundVal = Fix(lRoundVal / lFactor) * lFactor + lFactor

'If the original input value was a negative value,
'convert lRoundVal to a negative number.
If dInputVal < 0 Then
   lRoundVal = lRoundVal * -1
End If

NearestRoundValue = lRoundVal

Exit Function
ErrorHandle:
'An error could be overflow,
'if the number is too big.
MsgBox Err.Description
End Function

And here is an example procedure that calls the function above passing the input value. It displays the returned value (200000) in a messagebox. In real life the input value would probably be calculated or read from the spreadsheet.

Round to nearest in Excel with VBA macros