How to round up with excel VBA round()?
Asked Answered
P

15

11

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?

Pretension answered 15/4, 2013 at 14:15 Comment(1)
"That is, for value > 0.5, round up. And for value < 0.5, round down?" Actually, Round behaves that way. The problem is what it does for value = 0.5.Poulos
B
17

VBA uses bankers rounding in an attempt to compensate for the bias in always rounding up or down on .5; you can instead;

WorksheetFunction.Round(cells(1,1).value * cells(1,2).value, 2)
Burial answered 15/4, 2013 at 14:24 Comment(1)
what if i want to select this value after RoundUp? @Alex KWilkey
L
12

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)

Lemus answered 14/5, 2015 at 14:28 Comment(9)
Does not work for already round numbers. E.g. Round(41.0 + 0.5) will result in 42.Jazzman
In that case: answer = Iif(Int(x) = x, x, Round(x + 0.5)) which uses Int to check if it's roundKatlin
@Jazzman Isn't 42 the right answer? What's the problem?Yogi
@Yogi No, since 41 is already round, the answer should be 41. The 0.5 is only added in an attempt to always round a number up.Jazzman
Don't know what I was thinking. Meant to say use INT() function, not Round() function.Lemus
...maybe "round up" has a different meaning where I am. To me, "round up" means any value >x and <=y becomes y 1.01 becomes 2. I guess I'll stick with application.worksheetfunction.RoundUp(x,0) or application.worksheetfunction.Ceiling(x,1).Levalloisian
whhaaat? SO parses < + = as one symbol, <=? well ain't that cute! I'm surprised I never noticed that before.Levalloisian
@Yogi humor was totally wasted on MLC lmaoFact
@MCL: what about Int(x + 0.49)? @Ans: chaaaa :-DJoeljoela
P
11



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----------------
Party answered 14/11, 2013 at 4:41 Comment(0)
H
3

Try the RoundUp function:

Dim i As Double

i = Application.WorksheetFunction.RoundUp(Cells(1, 1).Value * Cells(1, 2).Value, 2)
Hodden answered 15/4, 2013 at 14:23 Comment(1)
-1, the OP asked for a function which rounds down for value <0.5. RoundUp does not behave that way.Poulos
M
3

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

Modiolus answered 20/6, 2016 at 9:47 Comment(1)
These are great functions!Singletary
S
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))
Santa answered 26/10, 2016 at 14:1 Comment(3)
x being the variable you want to only round up, count being the result you will use further on in your codeSanta
The way I was using the code was to determine how many pages in a calendar were needed to have one page per week for any given month. The equation was based on days in a month and when the first day of the month was.Santa
For clarity, I named the year and month variables years and months respectively because year and month are already functions in VBA. daysinmonth is of course how many days in a month determined with a previous equation. If anyone's interested, here is the code I used (maybe more parenthesis than needed but I didnt care to trial and error to use less): count = -1 * (Int((-1 * (daysinmonth + (DateSerial(years, months, 1) - 1))) / 7))Santa
M
0

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.

Melodee answered 22/7, 2016 at 5:16 Comment(0)
E
0

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.

Energetic answered 23/9, 2016 at 0:1 Comment(0)
S
0

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
Snow answered 14/12, 2016 at 10:0 Comment(0)
E
0

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
Elective answered 18/5, 2018 at 14:2 Comment(0)
U
0

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
Unorthodox answered 1/11, 2018 at 15:10 Comment(1)
Can you please provide some explanation for your answer as well so for the other users can also understand it easily.Footrest
U
0

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
Unbreathed answered 6/6, 2019 at 5:15 Comment(0)
O
0

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.

Oyez answered 13/10, 2019 at 16:11 Comment(0)
H
0

My propose that is equal to Worksheetfunction.RoundUp

Function RoundUp(ByVal Number As Double, Optional ByVal Digits As Integer = 0) As Double
    Dim TempNumber As Double, Mantissa As Double
    
    'If Digits is minor than zero assign to zero.
    If Digits < 0 Then Digits = 0
    
    'Get number for x digits
    TempNumber = Number * (10 ^ Digits)
    
    'Get Mantisa for x digits
    Mantissa = TempNumber - Int(TempNumber)
    
    'If mantisa is not zero, get integer part of TempNumber and increment for 1.
    'If mantisa is zero then we reach the total number of digits of the mantissa of the original number
    If Mantissa <> 0 Then
        RoundUp = (Int(TempNumber) + 1) / (10 ^ Digits)
    Else
        RoundUp = Number
    End If
End Function
Honeywell answered 18/4, 2021 at 16:10 Comment(0)
L
-3

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!

Literally answered 5/1, 2016 at 6:45 Comment(1)
How does this answer the question?Countryfied

© 2022 - 2024 — McMap. All rights reserved.