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?
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!
Source: Stackoverflow.com