'---------------------------------------------------------------------------------------
' Procedure : GetRoundedTo
' Author : mellon
' Date : 25/05/2016
' Purpose : Function was derived from a few search results and upgraded from vb.
'
' To return "The Rounded" nearest, rounded UP or rounded DOWN value based on inputting a number called mNumber,
' and the Target range and an optional parameter.
'
'Example: GetRoundedTo(7.51, .50, 1) means Round Up 7.51 to the next .50 ++> returns 8
' GetRoundedTo(7.51, .50, 2) means Round DOWN to the next .50 ====> returns 7.5
' GetRoundedTo(7.51, .50, 0) means Round to the NEAREST .50 ===> returns 7.5 (this is the default RoundingDirection)
'---------------------------------------------------------------------------------------
'
Function GetRoundedTo(mNumber As Double, mTarget As Double, Optional mDirection As RoundingDirection = Nearest) As Double
Dim nearestValue As Double
10 On Error GoTo GetRoundedTo_Error
20 nearestValue = (CInt(mNumber / mTarget) * mTarget)
30 Select Case mDirection
Case RoundingDirection.Nearest
40 GetRoundedTo = nearestValue
50 Case RoundingDirection.Up
60 If nearestValue >= mNumber Then
70 GetRoundedTo = nearestValue
80 Else
90 GetRoundedTo = nearestValue + mTarget
100 End If
110 Case RoundingDirection.Down
120 If nearestValue <= mNumber Then
130 GetRoundedTo = nearestValue
140 Else
150 GetRoundedTo = nearestValue - mTarget
160 End If
170 End Select
180 On Error GoTo 0
190 Exit Function
GetRoundedTo_Error:
200 MsgBox "Error " & Err.number & " in line " & Erl & " (" & Err.Description & ") in procedure GetRoundedTo of Module Module3"
End Function