Round UP, DOWN, NEAREST by a nickel, quater, dollar, or whatever!!!!!! 2

[dkillilea]

I'm an Accounting Manager at a large steel company. I need the most versatile rounding function I can get.

I found this function and added the "nearest" function so it can now round any way you could possibly want...UP..DOWN..NEAREST. It mimicks MS Excel rounding so you'll never have to explain any differences there.

Example of "rounding up" to the closest nickel or dime in a query: FIELD_NAME: RND_TO_NEAREST([PRICE],.05,"UP")


Example of rounding to the nearest 100 in a query: FIELD_NAME: RND_TO_NEAREST([PRICE],100,"NEAREST")

ENJOY!!!!!!!

Public Function RND_TO_NEAREST(Amt As Variant, Divisor As Variant, DIR_UP_DN_NEAREST As String) As Variant

On Error Resume Next
Dim Temp As Variant
Temp = (Amt / Divisor)
If Int(Temp) = Temp Then
RND_TO_NEAREST = Amt
Exit Function

Else
Select Case UCase(DIR_UP_DN_NEAREST)
Case "UP"
Temp = Int(Temp) + 1
RND_TO_NEAREST = Temp * Divisor
Exit Function
Case "DN"
Temp = Int(Temp)
RND_TO_NEAREST = Temp * Divisor
Exit Function
Case "NEAREST"
Temp = Round(Amt / Divisor) * Divisor
RND_TO_NEAREST = Temp
Exit Function
Case Else
Exit Function
End Select
End If
End Function


Thanks,
Doug

 

[MichaelRed]

interesting, and worth a star

MichaelRed

 

[strongm]

>It mimicks MS Excel rounding so you'll never have to explain any differences there.

Sorry to put a damper on this but -assuming you are referring to Excel's ROUNDDOWN and ROUNDUP functions - it doesn't, you know (try seeing what happens with negative numbers) ...

 

[dkillilea]

Option Compare Database
Option Explicit

Public Function RND_TO_NEAREST(Amt As Double, Divisor As Double, _
DIR_UP_DOWN_NEAREST As String) As Double
' *******************************************************************
' created 12-28-2005 by Doug Killilea with the help of Scott Bauer
' at Majestic Steel USA, Inc., Cleveland, OH
' *******************************************************************
' created to be the most versatile rounding function available.
' Any ideas for expansion greatly appreciated!!!
' *******************************************************************
' round UP, DOWN, NEAREST by a nickel, quarter, dime, half dollar,
' 10, 100, 1,000,000 or whatever you need
' rounding is always away from zero, i.e. (-10.25, .1, "UP") = -10.30
' *******************************************************************
' created to mimick MS Excel rounding, where 5's are rounded up,
' but please note that MS Excel can only round to a specified
' decimal place and this function can do that
' (i.e. tenths by making divisor .01) plus it also rounds
' up/down/nearest by a divisor to aid those of us in the steel ind.
' working with cwt's (i.e. 37.48 can be rounded down to the nearest
' divisor of .25, or 34.25) making reports look so much cleaner
' *******************************************************************
' Rounding concepts came from multiple sources and those people
' deserve credit for their ideas. Source for rounding up 5's -
' Dejan Mladenovic and Ken Getz article located at
'

http://advisor.com/doc/08884.

Source for rounding up/down
' originally came from Microsoft Help and Support at
'

http://support.microsoft.com/?kbid=209996

' *******************************************************************
' This function is designed to accept almost any number you could
' throw at it...but it does have a limit.
' *******************************************************************
' I chose double data type because that encompasses almost any
' number you might be looking to round.
' *******************************************************************
' Please note that double is accurate for rounding to a max of 14
' places to the right of the decimal
' *******************************************************************
' If you experience problems with this function please email me at
' dkillilea@majesticsteel.com or post a response where I have it
' posted at

http://www.tek-tips.com

Microsoft:Access Modules
' (VBA Coding) Forum
' *******************************************************************

' make sure we are analyzing a number and likewise it's not null
If Not IsNumeric(Amt) Then
Exit Function
Else
End If

' minimum error trapping
On Error Resume Next

' vba compiler converts decimal to binary and this leads to
' incorrect rounding
Dim lngX As Long
Dim varDec As Double
Dim varX As Double
varX = (Amt / Divisor)
lngX = CLng(varX)
varDec = (CDec(varX) - lngX)

' if amount to be rounded = our answer then we're done
Dim Temp As Double
Temp = CDec(Amt / Divisor)
If Int(Temp) = Temp Then
RND_TO_NEAREST = Amt
Exit Function
Else

' otherwise we need to manually round
' formulas for rounding negative numbers
If Int(Temp) < 0 Then

Select Case UCase(DIR_UP_DOWN_NEAREST)
Case "UP"
Temp = Int(Temp)
RND_TO_NEAREST = Temp * Divisor
Exit Function
Case "DOWN"
Temp = Int(Temp) + 1
RND_TO_NEAREST = Temp * Divisor
Exit Function
Case "NEAREST"
If varDec <= -0.5 Then
RND_TO_NEAREST = Divisor * (lngX - 1)
Exit Function
Else
RND_TO_NEAREST = Divisor * (lngX)
Exit Function
End If
Case Else
Exit Function
End Select

Else
'formulas for rounding positive numbers and zero
Select Case UCase(DIR_UP_DOWN_NEAREST)
Case "UP"
Temp = Int(Temp) + 1
RND_TO_NEAREST = Temp * Divisor
Exit Function
Case "DOWN"
Temp = Int(Temp)
RND_TO_NEAREST = Temp * Divisor
Exit Function
Case "NEAREST"
If varDec >= 0.5 Then
RND_TO_NEAREST = Divisor * (lngX + 1)
Exit Function
Else
RND_TO_NEAREST = Divisor * lngX
Exit Function
End If
Case Else
Exit Function
End Select
End If
End If
End Function