Rounding Nearest Dollar

J

Joe Montgomery

WinXPsp1
Office2003
Hi,
My knowledge in vba is limited but I know a little and the code below was
given to me and I have a little problem with it's answer.
It rounds to the nearest 1.00 but not consistently.
Example:1
1,730.00 x 5% = 86.50 = 1,816.50 total
The code rounds it to 1,816.00
Example:2
30.00 x 5%=1.50= 31.50 total
The code rounds it to 32.00
Each example the answer ended in .50 cents but the code round down on the
first and up on the second.
I would really like for it to see .50 and round up all the time.
Please, any help here and I would be grateful

Sub ChangeEntPriceShtPricesColD_RndNearest_Dollor()
Dim Increase As Double
'
ReDim OldRange(Range("D101", Range("lastRow").Offset(-1, -1)).Count)
Set OldWkb = ActiveWorkbook
Set OldSht = ActiveSheet
'
For Each cell In Range("D101", Range("lastRow").Offset(-1, -1))
i = i + 1
OldRange(i).Address = cell.Address
OldRange(i).Values = cell.Formula
Next cell
'
On Error GoTo ErrorControl_1
Application.DisplayAlerts = False
Increase = Application.InputBox(prompt:="Enter the percentage increase
you desire" & Chr(13) & _
"for 5%, enter 5, not (.05.)" & Chr(13) & Chr(13) & _
"Caution: If you make a mistake you have a single." & Chr(13) & _
"Undo. Select the (Undo Price Change Button)" _
, Title:="Round Nearest Dollar Increase", Left:=100, Type:=1)
'The following rounds answer to nearest dollar
Dim c As Range
For Each c In Intersect(Range("D101", Range("lastRow").Offset(-1, -1)),
ActiveSheet.UsedRange)
If Not IsEmpty(c) Then c.Value = Round(c.Value * (1 + (Increase /
100)), 0)
Next
Application.DisplayAlerts = True
End Sub
Regards,
 
M

Mike Tomasura

Here is a simple way of doing this.
Use the round function

=ROUND(D13,0)


if you need a loop for a column do this

For x = 1 To 1000
Range("d" & x) = Application.WorksheetFunction.Round(Range("d" & x), 0)
Next x




Joe Montgomery said:
WinXPsp1
Office2003
Hi,
My knowledge in vba is limited but I know a little and the code below was
given to me and I have a little problem with it's answer.
It rounds to the nearest 1.00 but not consistently.
Example:1
1,730.00 x 5% = 86.50 = 1,816.50 total
The code rounds it to 1,816.00
Example:2
30.00 x 5%=1.50= 31.50 total
The code rounds it to 32.00
Each example the answer ended in .50 cents but the code round down on the
first and up on the second.
I would really like for it to see .50 and round up all the time.
Please, any help here and I would be grateful

Sub ChangeEntPriceShtPricesColD_RndNearest_Dollor()
Dim Increase As Double
'
ReDim OldRange(Range("D101", Range("lastRow").Offset(-1, -1)).Count)
Set OldWkb = ActiveWorkbook
Set OldSht = ActiveSheet
'
For Each cell In Range("D101", Range("lastRow").Offset(-1, -1))
i = i + 1
OldRange(i).Address = cell.Address
OldRange(i).Values = cell.Formula
Next cell
'
On Error GoTo ErrorControl_1
Application.DisplayAlerts = False
Increase = Application.InputBox(prompt:="Enter the percentage increase
you desire" & Chr(13) & _
"for 5%, enter 5, not (.05.)" & Chr(13) & Chr(13) & _
"Caution: If you make a mistake you have a single." & Chr(13) & _
"Undo. Select the (Undo Price Change Button)" _
, Title:="Round Nearest Dollar Increase", Left:=100, Type:=1)
'The following rounds answer to nearest dollar
Dim c As Range
For Each c In Intersect(Range("D101",
Range("lastRow").Offset(-1, -1)),
 
J

Joe Montgomery

Thanks Mike,
but my knowledge of vba is less than maybe I suggested

Could you explain how I could use your example with my code that has a
speciifc range and an input box for a % increase.

Thanks very much for any help here
Joe
 
J

Joe Montgomery

Hello,
Mike seems to be gone but could someone else tell me why this formula is in
consistant on round up from 50 cents to rounding down from 50 cents
Please, any help here and I would be grateful

Example:1
1,730.00 x 5% = 86.50 = 1,816.50 total
The code rounds it to 1,816.00
Example:2
30.00 x 5%=1.50= 31.50 total
The code rounds it to 32.00
Each example the answer ended in .50 cents but the code round down on the
first and up on the second.
I would really like for it to see .50 and round up all the time.

Sub ChangeEntPriceShtPricesColD_RndNearest_Dollor()
Dim Increase As Double
Dim c As Range
'
ReDim OldRange(Range("D101", Range("lastRow").Offset(-1, -1)).Count)
Set OldWkb = ActiveWorkbook
Set OldSht = ActiveSheet
'
For Each cell In Range("D101", Range("lastRow").Offset(-1, -1))
i = i + 1
OldRange(i).Address = cell.Address
OldRange(i).Values = cell.Formula
Next cell
'
On Error GoTo ErrorControl_1
Application.DisplayAlerts = False
Increase = Application.InputBox(prompt:="Enter the percentage increase
you desire" & Chr(13) & _
"for 5%, enter 5, not (.05.)" _
Title:="Round Nearest Dollar Increase", Left:=100, Type:=1)
'
For Each c In Intersect(Range("D101",
Range("lastRow").Offset(-1, -1)),
ActiveSheet.UsedRange)
If Not IsEmpty(c) Then c.Value = Round(c.Value * (1 + (Increase
/100)), 0)
Next
Application.DisplayAlerts = True
End Sub
 
G

Guest

VBA Rounded these correctly. When rounding a number useing 5, you always round to an even number. For example

2 = Round(2.5, 0
2 = Round(1.5, 0)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top