YOU should be able to modify the code easily enough. The problem is that
the
original code is looking only for cells with formulas in them and when it
doesn't find any, you get the error and no SET is performed.
Just remove the .SpecialCells(xlCellTypeFormulas) portion of all of the
Set
statements. That will have the cellRange set to the entire range
regardless
of the cell's contents, formulas or values only. The code that I provided
already takes into consideration whether a cell is empty or not, and if
not
whether the displayed result is numeric and creates the Round() formula
properly in either case.
If you want 2 decimal places, change the ",0)" portion of the formulas
created to ",2)". You may want to try these changes on a copy of your
workbook to make sure the results are as you want them.
Hope this helps some.
jon said:
Your exactly right.
Thats what my problem is in my original post, the cells dont contain
formulas just absolute values i.e. numbers.
But I need to change values such as 25.456815245 to 25.60 etc.
Is there a way of doing this ?
BTW, thanks for your help
Jon
JLatham said:
Which line of code is giving you the error (when the error occurs,
choose
[Debug] and note which line is highlighted). I suspect it is one of
the
If PAGENO = # Then Set cellRange =...
statements. That would simply mean that there weren't cells with
formulas
in the group - perhaps only values. And that's probably why the On
Error
Resume Next was put into the code to begin with - to deal with ranges
that
might not have formulas.
:
Hi,
I actually changed the variation slightly, but I get an error (No
cells
found), but only if I comment out the on error resume next line.
There are values in every field.
Here is my code
Sub Add_Rounding()
Dim cellRange As Range
Dim Rng As Range
Dim cellFormula As String
Dim PAGENO As Integer
'On Error Resume Next
PAGENO = 0
START:
PAGENO = PAGENO + 1
If PAGENO = 14 Then GoTo FINISH
If PAGENO = 1 Then Set cellRange =
Range("E7:W52").SpecialCells(xlCellTypeFormulas)
If PAGENO = 2 Then Set cellRange =
Range("E66:W110").SpecialCells(xlCellTypeFormulas)
If PAGENO = 3 Then Set cellRange =
Range("E130:G143").SpecialCells(xlCellTypeFormulas)
If PAGENO = 4 Then Set cellRange =
Range("E146:G165").SpecialCells(xlCellTypeFormulas)
If PAGENO = 5 Then Set cellRange =
Range("E168:G187").SpecialCells(xlCellTypeFormulas)
If PAGENO = 6 Then Set cellRange =
Range("O124:Q143").SpecialCells(xlCellTypeFormulas)
If PAGENO = 7 Then Set cellRange =
Range("O146:Q165").SpecialCells(xlCellTypeFormulas)
If PAGENO = 8 Then Set cellRange =
Range("O168:Q187").SpecialCells(xlCellTypeFormulas)
If PAGENO = 9 Then Set cellRange =
Range("E196:G215").SpecialCells(xlCellTypeFormulas)
If PAGENO = 10 Then Set cellRange =
Range("E218:G237").SpecialCells(xlCellTypeFormulas)
If PAGENO = 11 Then Set cellRange =
Range("O197:Q215").SpecialCells(xlCellTypeFormulas)
If PAGENO = 12 Then Set cellRange =
Range("E248:Q256").SpecialCells(xlCellTypeFormulas)
If PAGENO = 13 Then Set cellRange =
Range("E262:Q270").SpecialCells(xlCellTypeFormulas)
For Each Rng In cellRange
If Not IsEmpty(Rng) Then
If IsNumeric(Rng) Then
If Rng.HasFormula Then
cellFormula = Mid(Rng.Formula, _
2, 1024)
If InStr(UCase(cellFormula), _
UCase("Round")) = 0 Then
Rng.Formula = "=Round(" _
& cellFormula & ",0)"
End If
Else
Rng.Formula = _
"=Round(" & Rng.Value & ",0)"
End If
End If
End If
Next
GoTo START
FINISH:
End Sub
Can you help ?
Jon
Try this variation:
Sub NewRounding()
Dim cellRange As Range
Dim Rng As Range
Dim cellFormula As String
Set cellRange = Range("A1:C10")
For Each Rng In cellRange
If Not IsEmpty(Rng) Then
If IsNumeric(Rng) Then
If Rng.HasFormula Then
cellFormula = Mid(Rng.Formula, _
2, 1024)
If InStr(UCase(cellFormula), _
UCase("Round")) = 0 Then
Rng.Formula = "=Round(" _
& cellFormula & ",0)"
End If
Else
Rng.Formula = _
"=Round(" & Rng.Value & ",0)"
End If
End If
End If
Next
End Sub
:
Hi,
In an earlier post John provided me with a macro to round the
values
in a
selected cell range.
The code was:
Sub Add_Rounding()
Dim cellRange As Range
Dim Rng As Range
Dim cellFormula As String
On Error Resume Next
Set cellRange =
Range("A1:C10").SpecialCells(xlCellTypeFormulas)
For Each Rng In cellRange
cellFormula = Mid(Rng.Formula, 2, 1024)
If InStr(UCase(cellFormula), UCase("Round")) = 0 Then
Rng.Formula = "=round(" & cellFormula & ",0)"
End If
Next Rng
End Sub
Unfortunately, some of my worksheets have fixed values not
calculated
values
in the fields, and the macro doesn't amend any cell that doesn't
begin
with
an = sign.
Can anyone tell me how to make it work for fixed values.
Thanks
Jon
