Rounding Macro

[willsth]

I am using the following bit of code which I picked up from a forum and it works fine except were I present it with an amount of 13.00 or 14.00 basically anything with 00 after the decimal point. Any clues how to get rid of the error !!

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

 

[TheAceMan1]

How are ya willsth . . .

For starters the following section of code you provided will always fail ...

[blue]   If InStr(1, roundStr, ".") = [purple][b]-1[/b][/purple] Then
      RoundAdv = dVal
      Exit Function
   End If[/blue]

... If all arguements are satisified (as you have done), return values from [blue]InStr[/blue] can only be:
[ol][li]Zero ([purple]0[/purple]), 2nd string [purple]"."[/purple] not found.[/li]
[li][purple]Index[/purple] into the string which is always greater than zero (0).[/li][/ol]
Meaning [blue]InStr()[/blue] never returns [purple]-1[/purple] or [purple]True![/purple]

Since the above fails anyway, you go on with the following:

[blue]   WholeNumberPart = Mid(roundStr, 1, InStr(1, roundStr, ".") - 1)
   DecimalPart = Mid(roundStr, (InStr(1, roundStr, ".")))[/blue]

Which also [purple]fails if integers are entered with no decimal point![/purple]

Not sure of what you want, but I believe the following is what you need in place of the code I say is not needed:

[blue]   If InStr(1, roundStr, ".") = [purple][b]0[/b][/purple] Then [green]'Demimal Point Not Found ... Return Integer![/green]
      RoundAdv = dVal
      Exit Function
   End If[/blue]

[blue]Your Thoughts? . . .[/blue]

BTW: Welcome to [blue]Tek-Tips![/blue] Do have a look at one of the links at the bottom of my post. The links will help you [blue]ask better questions[/blue], get [blue]quick responses[/blue], [blue]better answers[/blue], and insite into [blue]etiquette[/blue] here in the forums. Again . . . Welcome to [blue]Tek-Tips![/blue] [blue]Its Worthy Reading![/blue]

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[TheAceMan1]

To All . . .

For those following this thread, here's a readable version of the code provided by [blue]willsth[/blue]:

[blue]Public Function RoundAdv(ByVal dVal As Double, Optional ByVal iPrecision As Integer = 0) As Double
   Dim roundStr As String, WholeNumberPart As String, DecimalPart As String
   Dim i As Integer, RoundUpValue As Double
   
   roundStr = CStr(dVal)
   
   If InStr(1, roundStr, ".") = 0 Then 'Demimal Point Not Found!
      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[/blue]

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[willsth]

Thanks seems to have resolved the issue