Library code snippets
A better rounding function
By Luke Lesurf, published on 02 Jan 2004
VB's built in round function will round numbers like 12.085 down to 12.08. This is not correct in all cases as this number should be rounded up to 12.09. This round function allows for this.
Public Function RoundAdv(ByVal dVal As Double, Optional ByVal iPrecision As Integer = 0) As Double
Dim roundStr As String
Dim WholeNumberPart As String
Dim DecimalPart As String
Dim i As Integer
Dim RoundUpValue As Double
roundStr = CStr(dVal)
If InStr(1, roundStr, ".") = -1 Then
RoundAdv = dVal
Exit Function
End If
WholeNumberPart = Mid$(roundStr, 1, InStr(1, roundStr, ".") - 1)
DecimalPart = Mid$(roundStr, (InStr(1, roundStr, ".")))
If Len(DecimalPart) > iPrecision + 1 Then
Select Case Mid$(DecimalPart, iPrecision + 2, 1)
Case "0", "1", "2", "3", "4"
DecimalPart = Mid$(DecimalPart, 1, iPrecision + 1)
Case "5", "6", "7", "8", "9"
RoundUpValue = 0.1
For i = 1 To iPrecision - 1
RoundUpValue = RoundUpValue * 0.1
Next
DecimalPart = CStr(Val(Mid$(DecimalPart, 1, iPrecision + 1)) + RoundUpValue)
If Mid$(DecimalPart, 1, 1) <> "1" Then
DecimalPart = Mid$(DecimalPart, 2)
Else
WholeNumberPart = CStr(Val(WholeNumberPart) + 1)
DecimalPart = ""
End If
End Select
End If
RoundAdv = Val(WholeNumberPart & DecimalPart)
End Function
Erm I went to school, then college and then i got a job... In programming. I like to fly planes and go fishing. I dont like brussle sprouts or cabbage. Love walker's squares. And coke (as in cola)
Related articles
Related discussion
-
VB6 system conversion using VBA to Word 2007
by b.macgregor@vodamail.co.za (0 replies)
-
How to open .bat application from excel VBA or VB6
by NaseemAhmed (0 replies)
-
Outlook VBA query
by James Crowley (1 replies)
-
How to control IE from VBA
by NaseemAhmed (0 replies)
-
Run-time error '91'
by converter2009 (1 replies)
Related podcasts
-
Christian Beauclair
14 mai 2008 (�mission #0074) ::.Christian Beauclair: Stratégies de migration VB6 vers .NET Nous discutons avec Christian Beauclair des stratégies de migration VB6 vers .NET. Entre autres, nous discutons comment utiliser le "VB 6 Code Advisor" et le "Interop Forms Toolkit" pour ajouter la puiss...
Please try this
Public Function RoundAdv(ByVal Number As Variant, Optional lDigit As Long = 0) As Double
If Not IsNumeric(Number) Then Exit Function
RoundAdv = Round(CDbl(Number) + (IIf(Number < 0, -1, 1) / (10 * (10 ^ lDigit))), lDigit)
End Function
Public Function RoundAdv(ByVal dVal As Double, Optional ByVal iPrecision As Integer = 0) As Double
Dim roundStr As String
Dim WholeNumberPart As String
Dim DecimalPart As String
Dim i As Integer
Dim RoundUpValue As Double
Dim negative As Boolean
roundStr = CStr(dVal)
If InStr(1, roundStr, ".") = 0 Then
RoundAdv = dVal
Exit Function
End If
If dVal < 0 Then
negative = True
End If
WholeNumberPart = Mid$(roundStr, 1, InStr(1, roundStr, ".") - 1)
DecimalPart = Mid$(roundStr, (InStr(1, roundStr, ".")))
If Len(DecimalPart) > iPrecision + 1 Then
Select Case Mid$(DecimalPart, iPrecision + 2, 1)
Case "0", "1", "2", "3", "4"
DecimalPart = Mid$(DecimalPart, 1, iPrecision + 1)
Case "5", "6", "7", "8", "9"
RoundUpValue = 0.1
For i = 1 To iPrecision - 1
RoundUpValue = RoundUpValue * 0.1
Next
DecimalPart = CStr(Val(Mid$(DecimalPart, 1, iPrecision + 1)) + RoundUpValue)
If Mid$(DecimalPart, 1, 1) <> "1" Then
DecimalPart = Mid$(DecimalPart, 2)
Else
If negative Then
WholeNumberPart = CStr(Val(WholeNumberPart) - 1)
Else
WholeNumberPart = CStr(Val(WholeNumberPart) + 1)
End If
DecimalPart = ""
End If
End Select
End If
RoundAdv = Val(WholeNumberPart & DecimalPart)
If RoundAdv <> 0 Then
If negative And RoundAdv > 0 Then
RoundAdv = -1 * RoundAdv
End If
End If
This thread is for discussions of A better rounding function.