How to zero out cells with formulas in them but no precedents?

[Guest]

I have the below code I am using to try to zero out constant numbers in
models. The section I have 'ed out seems to work fine. The second section I
am trying to use to find cells which have formulas in them but no predents
and zero those.
Thanks for the help.

Sub Zeroing()


Dim rng As Range

' Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants,
xlNumbers)
' For Each cell In rng
' If Not IsDate(cell.Value) Then
' cell.Value = 0
' cell.Font.ColorIndex = 5
' End If
' Next cell
Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas,
xlNumbers)
For Each cell In rng
If Not shprec(ActiveCell) Then
cell.Value = 0
cell.Font.ColorIndex = 5
End If
Next cell

'
End Sub

Function shprec(cell As Range)

On Error GoTo noprec
cell.Precedents.Show
shprec = True
Exit Function

noprec:
shprec = False

End Function

 

[Tom Ogilvy]

Sub Zeroing()


Dim rng As Range

' Set rng = ActiveSheet.UsedRange _
.SpecialCells(xlCellTypeConstants, xlNumbers)
' For Each cell In rng
' If Not IsDate(cell.Value) Then
' cell.Value = 0
' cell.Font.ColorIndex = 5
' End If
' Next cell
Set rng = ActiveSheet.UsedRange _
.SpecialCells(xlCellTypeFormulas, xlNumbers)
For Each cell In rng
If cell.Precedents is nothing Then
cell.Value = 0
cell.Font.ColorIndex = 5
End If
Next cell

'
End Sub

Assumes precedents would be on the same sheet.

 

[Guest]

Tom, Thanks for your reply.

When I run the below code I am getting a "Run Tiem Error 1004 No Cells
Found" and the Debug point to the

"If cell.Precedents Is Nothing Then" line

Any ideas how to solve this?

 

[Tom Ogilvy]

Sub Zeroing()


Dim rng As Range
Dim rng1 As Range

' Set rng = ActiveSheet.UsedRange _
.SpecialCells(xlCellTypeConstants, xlNumbers)
' For Each cell In rng
' If Not IsDate(cell.Value) Then
' cell.Value = 0
' cell.Font.ColorIndex = 5
' End If
' Next cell
Set rng = ActiveSheet.UsedRange _
.SpecialCells(xlCellTypeFormulas, xlNumbers)
For Each cell In rng
set rng1 = nothing
on Error Resume Next
set rng1 = cell.Precedents
on Error goto 0
If rng1 is nothing Then
cell.Value = 0
cell.Font.ColorIndex = 5
End If
Next cell

'
End Sub