RoundToNearest

  • Thread starter Thread starter alex.richardson
  • Start date Start date
A

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
 
alex.richardson said:
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
Click to expand...

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
 
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)
 
Back
Top