RoundToNearest

[alex.richardson]

I want to round up to the next higher 1000. For example,
15,600 should be rounded to 16,000. When I use the
RoundToNearest function on the knowledgebase, 15,600 is
rounded to 17,000.

Code I'm using is shown below. In my query I'm
entering "RoundToNearest(Number,1000,up)". How can I
change the code or query to round up to the next higher
1000 in all cases?

Function RoundToNearest(dblNumber As Double,
varRoundAmount As Double, _
Optional varUp As Variant) As Double

Dim dblTemp As Double
Dim lngTemp As Long

dblTemp = dblNumber / varRoundAmount
lngTemp = Clng(dblTemp)

If lngTemp = dblTemp Then
RoundToNearest = dblNumber
Else
If IsMissing(varUp) Then
' round down
dblTemp = lngTemp
Else
' round up
dblTemp = lngTemp + 1
End If
RoundToNearest = dblTemp * varRoundAmount
End If
End Function

 

[Ron Hinds]

I want to round up to the next higher 1000. For example,
15,600 should be rounded to 16,000. When I use the
RoundToNearest function on the knowledgebase, 15,600 is
rounded to 17,000.

Code I'm using is shown below. In my query I'm
entering "RoundToNearest(Number,1000,up)". How can I
change the code or query to round up to the next higher
1000 in all cases?

Function RoundToNearest(dblNumber As Double,
varRoundAmount As Double, _
Optional varUp As Variant) As Double

Dim dblTemp As Double
Dim lngTemp As Long

dblTemp = dblNumber / varRoundAmount
lngTemp = Clng(dblTemp)

If lngTemp = dblTemp Then
RoundToNearest = dblNumber
Else
If IsMissing(varUp) Then
' round down
dblTemp = lngTemp
Else
' round up
dblTemp = lngTemp + 1
End If
RoundToNearest = dblTemp * varRoundAmount
End If
End Function

The "CLng" function is already rounding to 16. You are then incrementing the
value again, resulting in 17. Using your example numbers:

dblTemp = 15,600 / 1,000 = 15.6.

lngTemp = CLng(15.6) = 16

Try it with 15,400 and you will get the expected result. To fix it, you
could add or subtract .5 to the value *before* calling CLng:

Function RoundToNearest(dblNumber As Double, varRoundAmount As Double,
Optional varUp As Variant) As Double

Dim dblTemp As Double
Dim lngTemp As Long

dblTemp = dblNumber / varRoundAmount

If IsMissing(varUp) Then
' round down
dblTemp = dblTemp - 0.5
Else
' round up
dblTemp = dblTemp + 0.5
End If

lngTemp = CLng(dblTemp)

RoundToNearest = lngTemp * varRoundAmount

End Function

 

[Van T. Dinh]

From the Debug window:

?CLng(15600/1000)*1000
16000

Beware of the exact 500 rounding such as 15500 and 16500.
Test and make sure the results are what you want.

HTH
Van T. Dinh
MVP (Access)