Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.
Round(num / 1000) * 1000
Iif(num > 1000000, Round(num / 1000000) * 1000000, Iif(num > 1000, Round(num / 1000) * 1000, num))
Public Function RoundSignificantCurrency( _
ByVal curValue As Currency, _
ByVal bytSignificantDigits As Byte, _
Optional ByVal booInteger As Boolean) _
As Currency
' Rounds curValue to bytSignificantDigits digits.
'
' Performs no rounding if bytSignificantDigits is zero.
' Rounds to integer if booInteger is True.
'
' Rounds correctly curValue until max/min Value of currency type multiplied with
' 10 raised to the power of (the number of digits of the index of curValue) minus
' bytSignificantDigits.
' This equals roughly +/-922 * 10 ^ 12 for any Value of bytSignificantDigits.
'
' Requires:
' Function Log10.
'
' 2001-10-19. Cactus Data ApS, CPH.
' 2002-04-02. Added CDec() for correcting bit errors of reals.
' 2007-04-18. Int replaced with Fix to round negative values correctly.
' Parameter booInteger made Optional.
Dim dblTmp As Double
Dim dblFactor As Double
Dim dblPower As Double
' No special error handling.
On Error Resume Next
If bytSignificantDigits = 0 Or curValue = 0 Then
' Nothing to do.
Else
dblPower = Int(Log10(Abs(curValue))) + 1 - bytSignificantDigits
If booInteger = True Then
' No decimals.
If dblPower < 0 Then
dblPower = 0
End If
End If
dblFactor = 10 ^ dblPower
dblTmp = curValue / dblFactor
dblTmp = Fix(dblTmp + Sgn(dblTmp) / 2)
' Apply CDec() to correct for possible bit error when multiplying reals.
curValue = CDec(dblTmp * dblFactor)
End If
RoundSignificantCurrency = curValue
End Function
Public Function Log10( _
ByVal dblValue As Double) _
As Double
' Returns Log 10 of input dblValue.
' No error handling as this should be handled
' outside this function.
'
' Example:
'
' If dblMyValue > 0 then
' dblLogMyValue = Log10(dblMyValue)
' Else
' ' Do something else ...
' End If
Log10 = Log(dblValue) / Log(10)
End Function
/gustav
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Using a combo box ListItemsEditForm property | 5 | 44 | |
Runtime Error -2147467259 (80004005) | 7 | 50 | |
Access table not showing correct column | 6 | 25 | |
MS Access VBA Control Visibility Not Working Properly | 7 | 26 |
Join the community of 500,000 technology professionals and ask your questions.