VBspeed / VB6 to VB5 / Round
VBspeed © 2000-10, updated: 01-Jun-2010
Round


The Definition
Function Round
Returns a number rounded to a specified number of decimal places.
Native to VB6, but not to VB5.
Declaration:
Round(expression [,numDecimalPlaces])
Arguments:
expressionRequired. Numeric expression being rounded.
numDecimalPlacesOptional. Number indicating how many places to the right of the decimal are included in the rounding. If omitted, integers are returned by the Round function.
Remarks:
The native VB6 Round is problematic:
  • VB6 Round rounds 1/2 to nearest the even number (aka 'Banker's rounding')
    Round(1.5) => 2
    Round(2.5) => 2 !! should be 3 in 'Other people's rounding'
  • VB6 Round does *not* support numDecimalPlaces to be negative, eg:
    Round(123.45, -1) => 120 !! run-time error 5 in VB6
You may use this function (VB5/6-compatible) to verify the correctness of your emulation code (updated 20020404).


The Charts
Calls
Round15 made it necessary to change the setup of the test calls in order to make the test more realistic and fair. I now feed a predefined series of 100 different Double numbers into each function (repeating this again several 1000 times).
The Double number array is generated like this for call 1 and call 2:
For i = 1 To 100: adDum(i) = 100 / i: Next
and like this for call 3 (producing a sequence of 50 identical pairs):
For i = 1 To 100 Step 2: adDum(i) = 100 / i: adDum(i + 1) = adDum(i): Next
The timed code for all calls looks like this:
tmrPC.Reset
For x = 1 To lIter \ 100
  For x2 = 1 To 100: dRet = Round(adDum(x2), iDum): Next
Next
dElapsed = tmrPC.Elapsed
Call 1 iDum = 2, no serial pairs
Call 2 iDum = 7, no serial pairs
Call 3 iDum = 2, all numbers in serial pairs
 VB5
CodeAuthorDopingNotes
RoundVB6  
Round01 Donald 1
Round02 Getz/Gilbert 1
Round03 Getz/Gilbert 1
Round04 Guido 1
Round05 Donald 2
Round06 Keith 2
Round07 Jost 2
Round08 Jost 2
Round09 Donald 2
Round10 Donald 2
Round11 LyleAPI1
Round12 Gustav  
Round13 Jost  
Round14 Donald  
Round15 Gustav  
Round16 Filipe  
Round17 Filipe  
Call 1
   
X3.063.210Ás
X0.290.300Ás
X0.280.299Ás
X0.040.040Ás
X0.050.054Ás
X0.040.038Ás
X0.040.044Ás
X0.040.043Ás
X0.030.031Ás
X0.030.033Ás
X0.060.064Ás
51.601.676Ás
41.391.460Ás
31.131.190Ás
21.121.179Ás
62.722.857Ás
11.001.050Ás
Call 2
   
X3.463.933Ás
X0.260.292Ás
X0.270.303Ás
X0.040.045Ás
X0.050.055Ás
X0.030.039Ás
X0.040.045Ás
X0.040.041Ás
X0.030.031Ás
X0.030.034Ás
X0.060.066Ás
51.471.673Ás
41.271.447Ás
31.111.260Ás
21.081.229Ás
62.653.014Ás
11.001.137Ás
Call 3
   
X5.622.994Ás
X0.580.310Ás
X0.590.313Ás
X0.070.039Ás
X0.110.056Ás
X0.070.037Ás
X0.080.044Ás
X0.080.042Ás
X0.060.031Ás
X0.060.034Ás
X0.130.071Ás
53.211.709Ás
42.741.459Ás
32.251.197Ás
21.250.668Ás
65.322.833Ás
11.000.533Ás
 VB6
CodeAuthorDopingNotes
Round VB6 2
Round01 Donald 1
Round02 Getz/Gilbert 1
Round03 Getz/Gilbert 1
Round04 Guido 1
Round05 Donald 2
Round06 Keith 2
Round07 Jost 2
Round08 Jost 2
Round09 Donald 2
Round10 Donald 2
Round11 LyleAPI1
Round12 Gustav  
Round13 Jost  
Round14 Donald  
Round15 Gustav  
Round16 Filipe  
Round17 Filipe  
Call 1
X0.090.089Ás
X2.912.884Ás
X0.270.270Ás
X0.280.279Ás
X0.030.029Ás
X0.040.044Ás
X0.050.051Ás
X0.040.040Ás
X0.040.037Ás
X0.030.033Ás
X0.030.030Ás
X0.050.053Ás
51.791.775Ás
41.491.479Ás
31.141.132Ás
21.151.138Ás
62.842.809Ás
11.000.990Ás
Call 2
X0.080.085Ás
X3.443.536Ás
X0.270.281Ás
X0.270.279Ás
X0.040.036Ás
X0.050.050Ás
X0.050.048Ás
X0.040.038Ás
X0.040.041Ás
X0.030.028Ás
X0.030.027Ás
X0.050.053Ás
51.781.832Ás
41.461.501Ás
21.101.127Ás
31.131.159Ás
62.902.980Ás
11.001.027Ás
Call 3
X0.180.086Ás
X6.002.890Ás
X0.540.259Ás
X0.590.286Ás
X0.060.029Ás
X0.100.046Ás
X0.110.051Ás
X0.080.037Ás
X0.080.041Ás
X0.060.029Ás
X0.060.027Ás
X0.110.053Ás
53.741.801Ás
43.041.465Ás
32.321.116Ás
21.320.635Ás
65.812.798Ás
11.000.481Ás
Conclusions
Most of the codes submitted (including VB6's native Round) didn't pass the tough and ever toughening VBspeed tests for correctness. If you want Round(32.675, 2) to return 32.68 you have to go for the submissions from Round12 upwards.
Notes
  • (1) These functions do not work correct on all inputs. Not recommended for serious rounding business.
  • (2) These functions work fine on most inputs but fail on some "nasty reals", for example:
    RoundXX(33.675, 2) -> 33.67 (instead of the correct 33.68). So they also cannot be recommended for serious rounding business. Sigh!
Mail your code! How to read all those numbers


The Code
Round01
submitted 10-Sep-2000 by Donald Lessau  
Doping: none
Public Function Round01(dNum As Double, Optional numDecimalPlaces As Integer) As Double
' by Donald, donald@xbeat.net, 20000908
' NOTE: cannot deal with negative numDecimalPlaces
' NOTE: numDecimalPlaces cannot be larger than 127
' NOTE: fails with certain (eg. german) country settings
  If numDecimalPlaces >= 0 Then
    ' numDecimalPlaces cannot be larger than 127, else Format$ gives up
    If numDecimalPlaces > 127 Then
      numDecimalPlaces = 127
    End If
    ' use Format$ for the job
    Round01 = Val(Format$(dNum, "0." & String$(numDecimalPlaces, "#")))
  Else
    ' return unchanged
    Round01 = dNum
  End If
End Function
Author's comments: Just to prove how bad Format$ is ...
Donald's comments: See notes in code!

top | charts


Round02
added 13-Sep-2000
Doping: none
Public Function Round02(dblNumber As Double, Optional numDecimalPlaces As Integer) As Double
' by Ken Getz and Mike Gilbert, VBA Developer's Handbook (Sybex, 1999), page 180
' [slightly altered to match our specifications]
' NOTE: overflows if Abs(numDecimalPlaces) is too large
' NOTE: 1/2 rounding wrong when compiler option
'       'Remove Floating Point Error Checks' is checked
  Dim dblFactor As Double
  Dim dblTemp As Double
  dblFactor = 10 ^ numDecimalPlaces
  dblTemp = dblNumber * dblFactor + 0.5
  Round02 = Int(dblTemp) / dblFactor
End Function
Author's comments:
Donald's comments: See notes in code!

top | charts


Round03
added 13-Sep-2000
Doping: none
Public Function Round03(dblNumber As Double, Optional numDecimalPlaces As Integer) As Double
' by Ken Getz and Mike Gilbert, VBA Developer's Handbook (Sybex, 1999), page 180
' [slightly altered to match our specifications]
' NOTE: overflows if Abs(numDecimalPlaces) is too large
  Dim dblFactor As Double
  dblFactor = 10 ^ numDecimalPlaces
  ' CDbl is necessary else eg. Round03(1.2345, 3) would return 1.234
  Round03 = Int(CDbl(dblNumber * dblFactor + 0.5)) / dblFactor
End Function
Author's comments:
Donald's comments: See notes in code! I slightly altered the Getz/Gilbert code: appears to work more predictable now independent of compiler settings.

top | charts


Round04
submitted 16-Sep-2000 by Guido Beckmann  
Doping: none
Public Function Round04(dblNumber As Double, Optional numDecimalPlaces As Integer) As Double
' ę G.Beckmann   eMail: G.Beckmann@NikoCity.de
    Dim r#, c%

    r = 10#
    If numDecimalPlaces > 0 Then
        For c = 2 To numDecimalPlaces: r = r * 10#: Next c
    Else
        For c = numDecimalPlaces To 0: r = r / 10#: Next c
    End If

    Round04 = Int(dblNumber * r + 0.5000000000001) / r
End Function
Author's comments:
Donald's comments: This is better and faster than VB6's Round, so copy it and thank Guido!

top | charts


Round05
submitted 26-Sep-2000 by Donald Lessau  
Doping: none
Public Function Round05(dblNumber As Double, Optional numDecimalPlaces As Integer) As Double
' based on Round04 by G.Beckmann, G.Beckmann@NikoCity.de
' modified by Donald, donald@xbeat.net, 000926
    Dim c As Integer
    
    Round05 = 10#
    
    If numDecimalPlaces > 0 Then
      For c = 2 To numDecimalPlaces: Round05 = Round05 * 10#: Next c
    Else
      For c = numDecimalPlaces To 0: Round05 = Round05 / 10#: Next c
    End If
    
    If dblNumber > 0 Then
      Round05 = Int(CDbl(dblNumber * Round05 + 0.5)) / Round05
    Else
      Round05 = -Int(CDbl(-dblNumber * Round05 + 0.5)) / Round05
    End If
    
End Function
Author's comments:
Donald's comments:

top | charts


Round06
submitted 15-Oct-2000 by Keith Matzen  
Doping: none
Public Function Round06(dblNumber As Double, Optional intDecimalPlaces As Integer) As Double
' by Keith Matzen, kmatzen@ispchannel.com, 20001015
 
   Dim iNdx    As Integer
   Dim dScale  As Double
   
   Select Case intDecimalPlaces
      Case Is > 7
         If dblNumber >= 0# Then
            dScale = 100000000#
         Else
            dScale = -100000000#
         End If
         For iNdx = 9 To intDecimalPlaces: dScale = dScale * 10#: Next iNdx
         Round06 = Int(CDbl(dblNumber * dScale + 0.5)) / dScale
      Case Is >= 0
         If (intDecimalPlaces And 4) Then
            If (intDecimalPlaces And 2) Then
               If (intDecimalPlaces And 1) Then
                  If dblNumber > 0# Then
                     Round06 = Int(CDbl(dblNumber * 10000000# + 0.5)) / 10000000#    '7
                  Else
                     Round06 = Int(CDbl(dblNumber * -10000000# + 0.5)) / -10000000#  '7
                  End If
               Else
                  If dblNumber > 0# Then
                     Round06 = Int(CDbl(dblNumber * 1000000# + 0.5)) / 1000000#      '6
                  Else
                     Round06 = Int(CDbl(dblNumber * -1000000# + 0.5)) / -1000000#    '6
                  End If
               End If
            ElseIf (intDecimalPlaces And 1) Then
               If dblNumber > 0# Then
                  Round06 = Int(CDbl(dblNumber * 100000# + 0.5)) / 100000#           '5
               Else
                  Round06 = Int(CDbl(dblNumber * -100000# + 0.5)) / -100000#         '5
               End If
            Else
               If dblNumber > 0# Then
                  Round06 = Int(CDbl(dblNumber * 10000# + 0.5)) / 10000#             '4
               Else
                  Round06 = Int(CDbl(dblNumber * -10000# + 0.5)) / -10000#           '4
               End If
            End If
         ElseIf (intDecimalPlaces And 2) Then
            If (intDecimalPlaces And 1) Then
               If dblNumber > 0# Then
                  Round06 = Int(CDbl(dblNumber * 1000# + 0.5)) / 1000#               '3
               Else
                  Round06 = Int(CDbl(dblNumber * -1000# + 0.5)) / -1000#             '3
               End If
            Else
               If dblNumber > 0# Then
                  Round06 = Int(CDbl(dblNumber * 100# + 0.5)) / 100#                 '2
               Else
                  Round06 = Int(CDbl(dblNumber * -100# + 0.5)) / -100#               '2
               End If
            End If
         ElseIf (intDecimalPlaces And 1) Then
            If dblNumber > 0# Then
               Round06 = Int(CDbl(dblNumber * 10# + 0.5)) / 10#                      '1
            Else
               Round06 = Int(CDbl(dblNumber * -10# + 0.5)) / -10#                    '1
            End If
         Else
            If dblNumber > 0# Then
               Round06 = Int(CDbl(dblNumber + 0.5))                                  '0
            Else
               Round06 = -Int(CDbl(-dblNumber + 0.5))                                '0
            End If
         End If
      Case Else
         If dblNumber >= 0# Then
            dScale = 10#
         Else
            dScale = -10#
         End If
         For iNdx = intDecimalPlaces To -2: dScale = dScale * 10#: Next iNdx
         Round06 = Int(CDbl(dblNumber / dScale + 0.5)) * dScale
   End Select
   
End Function
Author's comments:
Donald's comments:

top | charts


Round07
submitted 16-Oct-2000 by Jost Schwider    vb-tec.de
Doping: none
Public Function Round07(dblNumber As Double, Optional ByVal numDecimalPlaces As Long) As Double
' by Jost Schwider, jost@schwider.de, 20001016
' modified by Donald, donald@xbeat.net

  Dim i As Long
  Static Pow10(-20 To 20) As Double
  
  ' calc powers of 10 once
  If Pow10(0) = 0 Then
    Pow10(0) = 1#
    For i = 1 To UBound(Pow10)
      Pow10(i) = Pow10(i - 1) * 10#
      Pow10(-i) = Pow10(1 - i) / 10#
    Next
  End If
  
  If dblNumber > 0 Then
    Round07 = Int(CDbl(dblNumber * Pow10(numDecimalPlaces) + 0.5)) * Pow10(-numDecimalPlaces)
  Else
    Round07 = -Int(CDbl(-dblNumber * Pow10(numDecimalPlaces) + 0.5)) * Pow10(-numDecimalPlaces)
  End If
  
End Function
Author's comments:
Donald's comments: If needed the array dimensions can be enlarged: I tested (-308 to 308) without noticing any difference in speed (for any non-first calls, of course).

top | charts


Round08
submitted 16-Oct-2000 by Jost Schwider    vb-tec.de
Doping: none
Public Static Function Round08(dblNumber As Double, Optional ByVal numDecimalPlaces As Long) As Double
' by Jost Schwider, jost@schwider.de, 20001016
' modified by Donald, donald@xbeat.net
  
  Dim i As Long
  Dim Pow10(-20 To 20) As Double
  
  ' calc powers of 10 once
  If Pow10(0) = 0 Then
    Pow10(0) = 1#
    For i = 1 To UBound(Pow10)
      Pow10(i) = Pow10(i - 1) * 10#
      Pow10(-i) = Pow10(1 - i) / 10#
    Next
  End If
  
  If dblNumber > 0 Then
    Round08 = Int(CDbl(dblNumber * Pow10(numDecimalPlaces) + 0.5)) * Pow10(-numDecimalPlaces)
  Else
    Round08 = -Int(CDbl(-dblNumber * Pow10(numDecimalPlaces) + 0.5)) * Pow10(-numDecimalPlaces)
  End If
  
End Function
Author's comments:
Donald's comments: The only difference to Round07 is the position of the Static declaration. Makes a lot of difference in speed!

top | charts


Round09
submitted 17-Oct-2000 by Donald Lessau  
Doping: none
Public Static Function Round09(dblNumber As Double, Optional ByVal numDecimalPlaces As Long) As Double
' by Donald, donald@xbeat.net, 20001017
' based on Round08 by Jost Schwider, jost@schwider.de
  
  Dim i As Long
  Dim dTmp As Double
  Dim Pow10(-20 To 20) As Double
  
  ' calc powers of 10 once
  If i = 0 Then   '(all vars are static)
    Pow10(0) = 1#
    For i = 1 To UBound(Pow10)
      Pow10(i) = Pow10(i - 1) * 10#
      Pow10(-i) = Pow10(1 - i) / 10#
    Next
  End If
  
  If dblNumber >= 0 Then
    dTmp = dblNumber * Pow10(numDecimalPlaces) + 0.5
    Round09 = Int(dTmp) * Pow10(-numDecimalPlaces)
  Else
    dTmp = -dblNumber * Pow10(numDecimalPlaces) + 0.5
    Round09 = -Int(dTmp) * Pow10(-numDecimalPlaces)
  End If
  
End Function
Author's comments:
Donald's comments: two little tricks made this one faster than Round08: first, since all vars are static in this procedure, we can check for i = 0 instead of Pow10(0) = 0; second, by employing the intermediate dTmp, we can save one Cdbl() function (which is necessary to avoid rounding errors in Round08 and several previous codes).

top | charts


Round10
submitted 18-Oct-2000 by Donald Lessau  
Doping: none
Public Static Function Round10(dblNumber As Double, Optional ByVal numDecimalPlaces As Long) As Double
' by Donald, donald@xbeat.net, 20001018
  
  Dim fInit As Boolean
  Dim numDecimalPlacesPrev As Long
  Dim dFac As Double
  Dim dFacInv As Double
  Dim dTmp As Double
  
  ' calc factor once for this depth of rounding
  If Not fInit Or numDecimalPlacesPrev <> numDecimalPlaces Then
    dFac = 10 ^ numDecimalPlaces
    dFacInv = 10 ^ -numDecimalPlaces
    numDecimalPlacesPrev = numDecimalPlaces
    fInit = True
  End If
  
  If dblNumber >= 0 Then
    dTmp = dblNumber * dFac + 0.5
    Round10 = Int(dTmp) * dFacInv
  Else
    dTmp = -dblNumber * dFac + 0.5
    Round10 = -Int(dTmp) * dFacInv
  End If
  
End Function
Author's comments:
Donald's comments: the trick is to recalc the factors only when they need to be changed. A cool strategy since in real world applications the degree of rounding is unlikely to vary a lot. Another advantage over Round07/08/09: you don't have to define the array-size in advance.

top | charts


Round11
submitted 18-Dec-2000 by Lyle Fairfield  
Doping: API
Private Declare Function VarR8Round Lib "oleaut32.dll" _
      (ByVal dIn As Double, ByVal nplaces As Long, dOut As Double) As Long

Public Function Round11(dblNumber As Double, _ Optional ByVal numDecimalPlaces As Long) As Double ' by Lyle Fairfield, LyleFairfield@CyRiv.Com, 20001218 ' NOTE: does "Bankers rounding" ' cannot handle negative numDecimalPlaces (returns zero invariably) VarR8Round dblNumber, numDecimalPlaces, Round11 End Function
Author's comments:
Donald's comments: See notes in code!
This is the fastest un-compiled Round function we have so far: interesting for an application like Access which doesn't compile its code.

top | charts


Round12
submitted 04-Apr-2002 by Gustav Brock  
Doping: none
Public Function Round12( _
  ByVal dblNumber As Double, _
  Optional ByVal intDecimals As Integer = 0) As Double
' by Gustav Brock, gustav@cactus.dk, 20020404
' Performs 4/5 rounding of positive and negative values
' symmetrical to zero.
'
' 2002-04-02. Gustav Brock, Cactus Data ApS, CPH.

  Dim dblValue  As Double
  Dim dblFactor As Double

  ' Ignore excessive values of intDecimals and dblValue.
  On Error GoTo Err_Round12

  dblFactor = 10 ^ intDecimals
  dblValue = dblNumber * dblFactor
  If Abs(dblValue) < 100000000000000# Then
    ' Add +/- 0.5 to perform correct 4/5 rounding down/up.
    dblValue = dblValue + (Sgn(dblNumber) / 2)
  Else
    ' Correct 4/5 rounding is done automatically.
  End If
  ' Force type cast to correct for bit error when adding reals
  ' caused by addition of dblValue and +/- 0.5.
  dblValue = Fix(vbNullString & dblValue) / dblFactor

Exit_Round12:
  Round12 = dblValue
  Exit Function

Err_Round12:
  ' Return input value unmodified.
  dblValue = dblNumber
  Resume Exit_Round12

End Function
Author's comments:
Donald's comments: This code is not speed-optimized in any way. It is really slow (BTW: the speed difference is far less within Office VBA, because Office VBA does not compile to native code). The only reason the code is shown here is: it works! And all other codes don't!

top | charts


Round13
submitted 19-Apr-2002 by Jost Schwider    vb-tec.de
Doping: none

Public Static Function Round13( _
    ByVal Value As Variant, _
    Optional ByVal digits As Integer = 0 _
  ) As Variant
  Dim i As Long
  Dim Pot10(-28 To 28) As Variant
' by Jost Schwider, jost@schwider.de, 20020419
  
  'Ggf. 10er-Potenzen vor-berechnen:
  If i = 0 Then
    For i = LBound(Pot10) To UBound(Pot10)
      Pot10(i) = CDec(10 ^ i)
    Next i
  End If
  
  'Los gehts:
  On Error Resume Next
    If Value > 0 Then
      Round13 = Int(Value * Pot10(digits) + 0.5) * Pot10(-digits)
    Else
      Round13 = -Int(-Value * Pot10(digits) + 0.5) * Pot10(-digits)
    End If
    If Err.Number Then Round13 = Value
  On Error GoTo 0
End Function
Author's comments:
Donald's comments:

top | charts


Round14
submitted 19-Apr-2002 by Donald Lessau  
Doping: none

Public Static Function Round14( _
    ByVal dblNumber As Double, _
    Optional ByVal numDecimalPlaces As Long = 0 _
  ) As Double
' by Donald, donald@xbeat.net, 20020419
' modification of Round10 inspired by Jost's Round13 (Variant = CDec!)
  Dim fInit As Boolean
  Dim numDecimalPlacesPrev As Long
  Dim vFac As Variant
  Dim dFacInv As Double
  
  ' calc factor once for this depth of rounding
  If Not fInit Or numDecimalPlacesPrev <> numDecimalPlaces Then
    vFac = CDec(10 ^ numDecimalPlaces)
    dFacInv = 10 ^ -numDecimalPlaces
    numDecimalPlacesPrev = numDecimalPlaces
    fInit = True
  End If
  
  On Error GoTo Err_Round14

  If dblNumber > 0 Then
    Round14 = Int(dblNumber * vFac + 0.5)
    Round14 = Round14 * dFacInv
  Else
    Round14 = -Int(-dblNumber * vFac + 0.5)
    Round14 = Round14 * dFacInv
  End If
  
  Exit Function
  
Err_Round14:
  Round14 = dblNumber
End Function
Author's comments:
Donald's comments: (1) Recalc the factors only when they need to be changed. A cool strategy since in real world applications the degree of rounding is unlikely to vary a lot. (2) One Variant is enough (compare Round13). (3) Faster errorhandling.

top | charts


Round15
submitted 09-May-2002 by Gustav Brock  
Doping: none
Public Function Round15( _
    ByVal dblNumber As Double, _
    Optional ByVal lngDecimals As Long = 0) _
    As Double
' By Gustav, gustav@cactus.dk, 20020509
' Modification of Round14
' by Donald, donald@xbeat.net, 20020419
' modification of Round10 inspired by Jost's Round13 (Variant = CDec!)

  Static dblNumberPrevious    As Double
  Static lngDecimalsPrevious  As Long
  Static varFactor            As Variant
  Static dblFactorInv         As Double
  Static dblValue             As Double

  Dim booNewDecimals          As Boolean
  Dim booNewNumber            As Boolean

  ' Ignore excessive values of lngDecimals and dblValue.
  On Error GoTo Err_Round15

  booNewNumber = dblNumber <> dblNumberPrevious
  booNewDecimals = lngDecimals <> lngDecimalsPrevious Or dblFactorInv = 0

  If booNewDecimals = True Then
    ' Calculate factor for this number of decimals.
    varFactor = CDec(10 ^ lngDecimals)
    dblFactorInv = 10 ^ -lngDecimals
    lngDecimalsPrevious = lngDecimals
  End If

  If booNewDecimals = True Or booNewNumber = True Then
    dblNumberPrevious = dblNumber
    If dblNumber = 0 Then
      dblValue = 0
    ElseIf dblNumber > 0 Then
      dblValue = Int(dblNumber * varFactor + 0.5)
      dblValue = dblValue * dblFactorInv
    Else
      dblValue = -Int(-dblNumber * varFactor + 0.5)
      dblValue = dblValue * dblFactorInv
    End If
  End If

Exit_Round15:
  Round15 = dblValue
  Exit Function

Err_Round15:
  ' Return input value unmodified.
  dblValue = dblNumber
  Resume Exit_Round15

End Function
Author's comments: I've expanded that idea [of Round14] a little also wrapping the number to be rounded in a static; this may be of value in a query because you may have series of identical numbers to round most noticeable the number zero.
Donald's comments: The performance price of this trick is minimal so if there's any chance of serial repetition in your numbers go for it!

top | charts


Round16
submitted 22-Mar-2005 by Filipe Lage
Doping: none
Public Function Round16(ByVal v As Double, Optional ByVal lngDecimals As Long = 0) As Double
' by Filipe Lage, fclage-NO~SPAM@kiss-ezlink.com, 20050322
  Round16 = CDbl(Format$(v * 10 ^ lngDecimals, "0")) / 10 ^ lngDecimals
End Function
Author's comments: Sure, it's not the fastest function, but it's the smallest one (just 1 line of code!!) w/out using external calls (TLB/API). Rounding works correctly even for negative decimal places calls. Compatible with non-English systems (that use comma instead of point for decimal separation).
Donald's comments:

top | charts


Round17
submitted 14-Jun-2005 by Filipe Lage, revised 02-Feb-2006; revised 01-Jun-2010
Doping: none
Public Function Round17(ByVal v As Double, Optional ByVal lngDecimals As Long = 0) As Double
  ' By Filipe Lage
  ' fclage@gmail.com
  ' msn: fclage@clix.pt
  ' Revision C by Donald - 20060201 - (Bugfix)
  ' Revision D by Jeroen De Maeijer - 20100529 - (Bugfix)
  ' Revision E by Filipe Lage - 20100530 (speed improvements)
  Dim xint As Double, yint As Double, xrest As Double
  Static PreviousValue    As Double
  Static PreviousDecimals As Long
  Static PreviousOutput   As Double
  Static M                As Double
      
  If PreviousValue = v And PreviousDecimals = lngDecimals Then Round17 = PreviousOutput: Exit Function
      ' Hey... it's the same number and decimals as before...
      ' So, the actual result is the same. No need to recalc it
  
  If v = 0 Then Exit Function
      ' no matter what rounding is made, 0 is always rounded to 0
      
  If PreviousDecimals = lngDecimals Then
      ' 20100530 Improvement by fclage - Moved M initialization here for speedup
      If M = 0 Then M = 1  ' Initialization - M is never 0 (it is always 10 ^ n)
      Else
      ' A different number of decimal places, means a new Multiplier
      PreviousDecimals = lngDecimals
      M = 10 ^ lngDecimals
      End If
  
  If M = 1 Then xint = v Else xint = v * CDec(M)
      ' Let's consider the multiplication of the number by the multiplier
      ' Bug fixed: If you just multiplied the value by M, those nasty reals came up
      ' So, we use CDEC(m) to avoid that
                                                              
  Round17 = Fix(xint)
      ' The real integer of the number (unlike INT, FIX reports the actual number)
  
  ' 20060201: fix by Donald
  If Abs(Fix(10 * (xint - Round17))) > 4 Then
    If xint < 0 Then '20100529 fix by Zoenie:
    ' previous code would round -0,0714285714 with 1 decimal in the end result to 0.1 !!!
    ' 20100530 Speed improvement by Filipe - comparing vars with < instead of >=
      Round17 = Round17 - 1
    Else
      Round17 = Round17 + 1
    End If
  End If
      ' First decimal is 5 or bigger ? If so, we'll add +1 or -1 to the result (later to be divided by M)
  
  If M = 1 Then Else Round17 = Round17 / M
      ' Divides by the multiplier. But we only need to divide if M isn't 1
  
  PreviousOutput = Round17
  PreviousValue = v
      ' Let's save this last result in memory... may be handy ;)
End Function
Author's comments:
Donald's comments:

top | charts




VBspeed © 2000-10 by Donald Lessau