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,