[excel] How to round up with excel VBA round()?

I have the following data:

cell(1,1) = 2878.75
cell(1,2) = $31.10
cell(2,1) = $89,529.13

However, when I tried to use round(cells(1,1).value*cells(1,2).value),2), the result does not match cell(2,1). I figured it has to do with the rounding issue, but I'm just wondering if it is possible to get round() to act normally. That is, for value > 0.5, round up. And for value < 0.5, round down?

This question is related to excel vba

The answer is


The answers here are kind of all over the map, and try to accomplish several different things. I'll just point you to the answer I recently gave that discusses the forced rounding UP -- i.e., no rounding toward zero at all. The answers in here cover different types of rounding, and ana's answer for example is for forced rounding up.

To be clear, the original question was how to "round normally" -- so, "for value > 0.5, round up. And for value < 0.5, round down".

The answer that I link to there discusses forced rounding up, which you sometimes also want to do. Whereas Excel's normal ROUND uses round-half-up, its ROUNDUP uses round-away-from-zero. So here are two functions that imitate ROUNDUP in VBA, the second of which only rounds to a whole number.

Function RoundUpVBA(InputDbl As Double, Digits As Integer) As Double

    If InputDbl >= O Then
        If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl + 0.5 / (10 ^ Digits), Digits)
    Else
        If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl - 0.5 / (10 ^ Digits), Digits)
    End If

End Function

Or:

Function RoundUpToWhole(InputDbl As Double) As Integer

    Dim TruncatedDbl As Double

    TruncatedDbl = Fix(InputDbl)

    If TruncatedDbl <> InputDbl Then
        If TruncatedDbl >= 0 Then RoundUpToWhole = TruncatedDbl + 1 Else RoundUpToWhole = TruncatedDbl - 1
    Else
        RoundUpToWhole = TruncatedDbl
    End If

End Function

Some of the answers above cover similar territory, but these here are self-contained. I also discuss in my other answer some one-liner quick-and-dirty ways to round up.




Try this function, it's ok to round up a double

'---------------Start -------------
Function Round_Up(ByVal d As Double) As Integer
    Dim result As Integer
    result = Math.Round(d)
    If result >= d Then
        Round_Up = result
    Else
        Round_Up = result + 1
    End If
End Function
'-----------------End----------------

If you want to round up, use half adjusting. Add 0.5 to the number to be rounded up and use the INT() function.

answer = INT(x + 0.5)


Here's one I made. It doesn't use a second variable, which I like.

        Points = Len(Cells(1, i)) * 1.2
        If Round(Points) >= Points Then
            Points = Round(Points)
        Else: Points = Round(Points) + 1
        End If

I am introducing Two custom library functions to be used in vba, which will serve the purpose of rounding the double value instead of using WorkSheetFunction.RoundDown and WorkSheetFunction.RoundUp

Function RDown(Amount As Double, digits As Integer) As Double
    RDown = Int((Amount + (1 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function

Function RUp(Amount As Double, digits As Integer) As Double
    RUp = RDown(Amount + (5 / (10 ^ (digits + 1))), digits)
End Function

Thus function Rdown(2878.75 * 31.1,2) will return 899529.12 and function RUp(2878.75 * 31.1,2) will return 899529.13 Whereas The function Rdown(2878.75 * 31.1,-3) will return 89000 and function RUp(2878.75 * 31.1,-3) will return 90000


This worked for me

Function round_Up_To_Int(n As Double)
    If Math.Round(n) = n Or Math.Round(n) = 0 Then
        round_Up_To_Int = Math.Round(n)
    Else: round_Up_To_Int = Math.Round(n + 0.5)
    End If
End Function

I find the following function sufficient:

'
' Round Up to the given number of digits
'
Function RoundUp(x As Double, digits As Integer) As Double

    If x = Round(x, digits) Then
        RoundUp = x
    Else
        RoundUp = Round(x + 0.5 / (10 ^ digits), digits)
    End If

End Function

Used the function "RDown" and "RUp" from ShamBhagwat and created another function that will return the round part (without the need to give "digits" for input)

Function RoundDown(a As Double, digits As Integer) As Double
    RoundDown = Int((a + (1 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function

Function RoundUp(a As Double, digits As Integer) As Double
    RoundUp = RoundDown(a + (5 / (10 ^ (digits + 1))), digits)
End Function

Function RDownAuto(a As Double) As Double
    Dim i As Integer
    For i = 0 To 17
        If Abs(a * 10) > WorksheetFunction.Power(10, -(i - 1)) Then
            If a > 0 Then
                RDownAuto = RoundDown(a, i)
            Else
                RDownAuto = RoundUp(a, i)
            End If
        Exit Function
        End If
    Next
End Function

the output will be:

RDownAuto(458.067)=458
RDownAuto(10.11)=10
RDownAuto(0.85)=0.8
RDownAuto(0.0052)=0.005
RDownAuto(-458.067)=-458
RDownAuto(-10.11)=-10
RDownAuto(-0.85)=-0.8
RDownAuto(-0.0052)=-0.005

Math.Round uses Bankers rounding and will round to the nearest even number if the number to be rounded falls exactly in the middle.

Easy solution, use Worksheetfunction.Round(). That will round up if its on the edge.


Try the RoundUp function:

Dim i As Double

i = Application.WorksheetFunction.RoundUp(Cells(1, 1).Value * Cells(1, 2).Value, 2)

I had a problem where I had to round up only and these answers didnt work for how I had to have my code run so I used a different method. The INT function rounds towards negative (4.2 goes to 4, -4.2 goes to -5) Therefore, I changed my function to negative, applied the INT function, then returned it to positive simply by multiplying it by -1 before and after

Count = -1 * (int(-1 * x))

This is an example j is the value you want to round up.

Dim i As Integer
Dim ii, j As Double

j = 27.11
i = (j) ' i is an integer and truncates the decimal

ii = (j) ' ii retains the decimal

If ii - i > 0 Then i = i + 1 

If the remainder is greater than 0 then it rounds it up, simple. At 1.5 it auto rounds to 2 so it'll be less than 0.


I got a workaround myself:

    'G = Maximum amount of characters for width of comment cell
    G = 100
    'CommentX
    If THISWB.Sheets("Source").Cells(i, CommentColumn).Value = "" Then
        CommentX = ""
     Else
        CommentArray = Split(THISWB.Sheets("Source").Cells(i, CommentColumn).Value, Chr(10)) 'splits on alt + enter
        DeliverableComment = "Available"
    End If
                        If CommentX <> "" Then

                            'this loops for each newline in a cell (alt+enter in cell)
                            For CommentPart = 0 To UBound(CommentArray)
                            'format comment to max G characters long
                                LASTSPACE = 0
                                LASTSPACE2 = 0
                                    If Len(CommentArray(CommentPart)) > G Then

                                        'find last space in G length character string to make sure the line ends with a whole word and the new line starts with a whole word
                                        Do Until LASTSPACE2 >= Len(CommentArray(CommentPart))
                                            If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
                                                LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
                                                ActiveCell.AddComment Left(CommentArray(CommentPart), LASTSPACE)
                                            Else
                                                If LASTSPACE2 = 0 Then
                                                   LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
                                                   ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Left(CommentArray(CommentPart), LASTSPACE)
                                                Else
                                                   If Len(Mid(CommentArray(CommentPart), LASTSPACE2)) < G Then
                                                       LASTSPACE = Len(Mid(CommentArray(CommentPart), LASTSPACE2))
                                                       ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
                                                   Else
                                                       LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "þ", (Len(Mid(CommentArray(CommentPart), LASTSPACE2, G)) - Len(WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "")))))
                                                       ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
                                                   End If
                                                End If
                                            End If
                                            LASTSPACE2 = LASTSPACE + LASTSPACE2 + 1
                                        Loop
                                    Else
                                        If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
                                          ActiveCell.AddComment CommentArray(CommentPart)
                                        Else
                                          ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & CommentArray(CommentPart)
                                        End If
                                    End If

                            Next CommentPart
                            ActiveCell.Comment.Shape.TextFrame.AutoSize = True

                        End If

Feel free to thank me. Works like a charm to me and the autosize function also works!