I Need A Number Rounding Fuction

[PaulB]

Hi

Has anyone got a function to email to me that rounds a floating point number to a certain number of decimal places.

The built in VB Round() function has bugs.

I read somewhere on this site that is you round 3.45 to 1 decimal place, it will make it 3.4 rather than 3.5

This is quite urgent, so please help.

Thanks!

[Sam Finch]

write your own rounding function

Public Function MyRound(Number as Double,Optional NoDP as Integer = 0)

Dim strNumber as String

strNumber = cStr(Number) 'Convert number to string

If Right$(strNumber,1)="5" Then 'If number ends in a 5

    MyRound = Round(cDbl(strNumber & "1"),NoDP)

Else

    MyRound = Round(Number,NoDP)

End If

End Function

Hope this helps.

[SonGouki]

Or you could use the Format function, as follows:

Format(CDbl(Text1.Text), "0.00")

[crutchlb]

Most of the work I do requires mathematical values being rounded to all different formats. I usually do each one individually.
Where X is my value

Result = (Int((X)*100 + .499999))/100
would round to the nerest .01

that's the basic format. You can get decimal fractions too.

Result = (Int((X)* 4 )) / 4
round to nearest LOWEST 1/4

Hope this helps.

What I do find fifficult is working with angles.
My data is usually entered in as DD-MM-SS-. I can easily convert it into a decimal angle. But to then to convert back to DD-MM-SS-. Sometimes you end up with a value of 60 in the Seconds.

[_bman_]

i didn't really test this to much, but it should work (i hope)

Public Function trueRound(num As Double, numOfPlaces As Long) As Double
    Dim x As Double, s As String
    Dim decP As Long

    s = CStr(num)
    
    'find decimal
    For x = 1 To Len(s)
        If Mid$(s, x, 1) = "." Then
            decP = x
        End If
    Next
    
    'move the number after where you are rounding to and change it to 6
    'to force the correct rounding
    If Mid$(s, decP + numOfPlaces + 1, 1) = "5" Then
        Mid(s, decP + numOfPlaces + 1, 1) = "6"
    End If
    
    num = CDbl(s)
    
    'round as normal
    x = Round(num, numOfPlaces)
    
    trueRound = x
    
End Function

[rdeeming]

If you try rounding 0.5 by adding 0.4999999, you won't get the right answer. The function below will round to any number of decimal places (including negatives!), and will pass any errors back to the calling procedure.

I have also included a function to convert a decimal angle to D-M-S format, which catches the rounding errors that cause 60 to appear in the minutes or seconds. It will return a string representation, but you can use the optional parameters to return the individual parts (lngDeg, lngMin and dblSec). You can use the last parameter (lngSecDP) to specify the number of decimal places to round the seconds to.

Hope this helps:

Function Round(dblNumber As Double, _
Optional lngDP As Long = 0) As Double

Dim dblPW As Double

dblPW = 10 ^ lngDP
Round = Int((dblNumber * dblPW) + 0.5) / dblPW

End Function

Function Deg2DMS(dblDegrees As Double, _
Optional lngDeg As Long, _
Optional lngMin As Byte, _
Optional dblSec As Double, _
Optional lngSecDP As Long = 2) _
As String

Dim dblTemp As Double
Dim strFmt As String

dblTemp = dblDegrees
lngDeg = Int(dblTemp)
dblTemp = (dblTemp - lngDeg) * 60
lngMin = Int(dblTemp)
dblTemp = (dblTemp - lngMin) * 60
dblSec = dblTemp

If lngSecDP > 0 Then
strFmt = "00." & String$(lngSecDP, "0")
Else
strFmt = "00"
End If
If Round(dblSec, lngSecDP) = 60 Then
'Round up seconds
If lngMin = 59 Then
Deg2DMS = (lngDeg + 1) & Chr$(176) & _
" 00` " & Format$(0, strFmt) & "``"
Else
Deg2DMS = lngDeg & Chr$(176) & " " & _
Format$((lngMin + 1), "00") & _
"` " & Format$(0, strFmt) & "``"
End If
Else
Deg2DMS = lngDeg & Chr$(176) & " " & _
Format$(lngMin, "00") & "` " & _
Format$(dblSec, strFmt) & "``"
End If

End Function

[PaulB]

Thanks a lot. The function and examples helped me out a lot.

[skinyon]

The Round() function is *buggy* only if you do not now what it is for. The Round() function uses Banker's rounding, not Arithmetic rounding. Read article Q194983 from the Microsoft Knowledge Base:

"The Round() function in Visual Basic for Applications 6, uses Banker's rounding, which rounds .5 either up or down, whichever will result in an even number."

"STATUS
This behavior is by design."

Want the full spec's on why this is? Read: "Q196652 - HOWTO: Implement Custom Rounding Procedures" This gives you a comparison of different rounding algorithms.

Please research your *bugs* before letting the allegations fly or you will unjustly drag on VB's reputation of being *buggy*.

Thanks,
S. Kinyon

[Paul282]

That's fasinating. I just read though the articles, the different rounding techniques look like this

FYI

Function AsymDown(ByVal X As Double, _
            Optional ByVal Factor As Double = 1) As Double
     AsymDown = Int(X * Factor) / Factor
   End Function

   Function SymDown(ByVal X As Double, _
            Optional ByVal Factor As Double = 1) As Double
     SymDown = Fix(X * Factor) / Factor
   '  Alternately:
   '  SymDown = AsymDown(Abs(X), Factor) * Sgn(X)
   End Function

   Function AsymUp(ByVal X As Double, _
            Optional ByVal Factor As Double = 1) As Double
   Dim Temp As Double
     Temp = Int(X * Factor)
     AsymUp = (Temp + IIf(X = Temp, 0, 1)) / Factor
   End Function

   Function SymUp(ByVal X As Double, _
            Optional ByVal Factor As Double = 1) As Double
   Dim Temp As Double
     Temp = Fix(X * Factor)
     SymUp = (Temp + IIf(X = Temp, 0, Sgn(X))) / Factor
   End Function

   Function AsymArith(ByVal X As Double, _
            Optional ByVal Factor As Double = 1) As Double
     AsymArith = Int(X * Factor + 0.5) / Factor
   End Function

   Function SymArith(ByVal X As Double, _
            Optional ByVal Factor As Double = 1) As Double
     SymArith = Fix(X * Factor + 0.5 * Sgn(X)) / Factor
   '  Alternately:
   '  SymArith = Abs(AsymArith(X, Factor)) * Sgn(X)
   End Function

   Function BRound(ByVal X As Double, _
            Optional ByVal Factor As Double = 1) As Double
   '  For smaller numbers:
   '  BRound = CLng(X * Factor) / Factor
   Dim Temp As Double, FixTemp As Double
     Temp = X * Factor
     FixTemp = Fix(Temp + 0.5 * Sgn(X))
     ' Handle rounding of .5 in a special manner
     If Temp - Int(Temp) = 0.5 Then
       If FixTemp / 2 <> Int(FixTemp / 2) Then ' Is Temp odd
         ' Reduce Magnitude by 1 to make even
         FixTemp = FixTemp - Sgn(X)
       End If
     End If
     BRound = FixTemp / Factor
   End Function

   Function RandRound(ByVal X As Double, _
            Optional ByVal Factor As Double = 1) As Double
   ' Should Execute Randomize statement somewhere prior to calling.
   Dim Temp As Double, FixTemp As Double
     Temp = X * Factor
     FixTemp = Fix(Temp + 0.5 * Sgn(X))
     ' Handle rounding of .5 in a special manner.
     If Temp - Int(Temp) = 0.5 Then
       ' Reduce Magnitude by 1 in half the cases.
       FixTemp = FixTemp - Int(Rnd * 2) * Sgn(X)
     End If
     RandRound = FixTemp / Factor
   End Function

   Function AltRound(ByVal X As Double, _
            Optional ByVal Factor As Double = 1) As Double
   Static fReduce As Boolean
   Dim Temp As Double, FixTemp As Double
     Temp = X * Factor
     FixTemp = Fix(Temp + 0.5 * Sgn(X))
     ' Handle rounding of .5 in a special manner.
     If Temp - Int(Temp) = 0.5 Then
       ' Alternate between rounding .5 down (negative) and up (positive).
       If (fReduce And Sgn(X) = 1) Or (Not fReduce And Sgn(X) = -1) Then
       ' Or, replace the previous If statement with the following to
       ' alternate between rounding .5 to reduce magnitude and increase
       ' magnitude.
       ' If fReduce Then
         FixTemp = FixTemp - Sgn(X)
       End If
       fReduce = Not fReduce
     End If
     AltRound = FixTemp / Factor
   End Function

   Function ADownDigits(ByVal X As Double, _
            Optional ByVal Digits As Integer = 0) As Double
     ADownDigits = AsymDown(X, 10 ^ Digits)
   End Function

[PaulB]

FAO Skinyon:

It actually says on this web site that the function is buggy. So complain to them, not me.

You could use the CInt function to round the number up as well. Except this function rounds it to the nearest whole number.

MyVal = 1.7
MyNewVal = CInt(MyVal)

[Sam Finch]

In which case use

CInt(MyVal - 0.5)