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: expression Required. Numeric expression being rounded. numDecimalPlaces Optional. 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
 Code Author Doping Notes Round VB6 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 Lyle API 1 Round12 Gustav Round13 Jost Round14 Donald Round15 Gustav Round16 Filipe Round17 Filipe
 Call 1 X 3.06 3.210µs X 0.29 0.300µs X 0.28 0.299µs X 0.04 0.040µs X 0.05 0.054µs X 0.04 0.038µs X 0.04 0.044µs X 0.04 0.043µs X 0.03 0.031µs X 0.03 0.033µs X 0.06 0.064µs 5 1.60 1.676µs 4 1.39 1.460µs 3 1.13 1.190µs 2 1.12 1.179µs 6 2.72 2.857µs 1 1.00 1.050µs
 Call 2 X 3.46 3.933µs X 0.26 0.292µs X 0.27 0.303µs X 0.04 0.045µs X 0.05 0.055µs X 0.03 0.039µs X 0.04 0.045µs X 0.04 0.041µs X 0.03 0.031µs X 0.03 0.034µs X 0.06 0.066µs 5 1.47 1.673µs 4 1.27 1.447µs 3 1.11 1.260µs 2 1.08 1.229µs 6 2.65 3.014µs 1 1.00 1.137µs
 Call 3 X 5.62 2.994µs X 0.58 0.310µs X 0.59 0.313µs X 0.07 0.039µs X 0.11 0.056µs X 0.07 0.037µs X 0.08 0.044µs X 0.08 0.042µs X 0.06 0.031µs X 0.06 0.034µs X 0.13 0.071µs 5 3.21 1.709µs 4 2.74 1.459µs 3 2.25 1.197µs 2 1.25 0.668µs 6 5.32 2.833µs 1 1.00 0.533µs
VB6
 Code Author Doping Notes 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 Lyle API 1 Round12 Gustav Round13 Jost Round14 Donald Round15 Gustav Round16 Filipe Round17 Filipe
 Call 1 X 0.09 0.089µs X 2.91 2.884µs X 0.27 0.270µs X 0.28 0.279µs X 0.03 0.029µs X 0.04 0.044µs X 0.05 0.051µs X 0.04 0.040µs X 0.04 0.037µs X 0.03 0.033µs X 0.03 0.030µs X 0.05 0.053µs 5 1.79 1.775µs 4 1.49 1.479µs 3 1.14 1.132µs 2 1.15 1.138µs 6 2.84 2.809µs 1 1.00 0.990µs
 Call 2 X 0.08 0.085µs X 3.44 3.536µs X 0.27 0.281µs X 0.27 0.279µs X 0.04 0.036µs X 0.05 0.050µs X 0.05 0.048µs X 0.04 0.038µs X 0.04 0.041µs X 0.03 0.028µs X 0.03 0.027µs X 0.05 0.053µs 5 1.78 1.832µs 4 1.46 1.501µs 2 1.10 1.127µs 3 1.13 1.159µs 6 2.90 2.980µs 1 1.00 1.027µs
 Call 3 X 0.18 0.086µs X 6.00 2.890µs X 0.54 0.259µs X 0.59 0.286µs X 0.06 0.029µs X 0.10 0.046µs X 0.11 0.051µs X 0.08 0.037µs X 0.08 0.041µs X 0.06 0.029µs X 0.06 0.027µs X 0.11 0.053µs 5 3.74 1.801µs 4 3.04 1.465µs 3 2.32 1.116µs 2 1.32 0.635µs 6 5.81 2.798µs 1 1.00 0.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! 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!

 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!

 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.

 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!

 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:

 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:

 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).

 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!

 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).

 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.

 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.

 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!

 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:

 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.

 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!

 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:

 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:

VBspeed © 2000-10 by Donald Lessau