Identify each cell that has dependents

[Jim]

Below is a piece of code that I've been trying to modify. The code is
supposed to walk through the entire workbook and identify each cell
that has dependents. As I am working with a huge model, this would
take far too much time, and I would like to limit the macro to run
only a select few sheets. It would actually be even better if it only
ran on the active sheet, but I don't want to be picky. Any ideas?


=============================

Sub HighlightInputCells()

Dim wks As Worksheet
Dim rngFormulas As Range
Dim rngCell As Range
Dim vSheetLst As Variant

vSheetList = Array("Sheet2", "Sheet1")

Application.ScreenUpdating = False


For i = LBound(vSheetList) To UBound(vSheetList)
Worksheets(sheetlist(i)).Activate
On Error Resume Next
Set rngFormulas =
Union(wks.UsedRange.SpecialCells(xlCellTypeBlanks),
wks.UsedRange.SpecialCells(xlCellTypeConstants))
If Not rngFormulas Is Nothing Then
For Each rngCell In rngFormulas
If HasDependents(rngCell) Then rngCell.Interior.ColorIndex
= 3
Next rngCell
Set rngFormulas = Nothing
End If
Next wks
Application.ScreenUpdating = True

End Sub

Function HasDependents(rngCheck As Range) As Boolean
Dim lngSheetCounter As Long
Dim lngRefCounter As Long
Dim rngDep As Range

On Error Resume Next
With rngCheck
.ShowDependents False
Set rngDep = .NavigateArrow(False, 1, 1)
If rngDep.Address(external:=True) =
rngCheck.Address(external:=True) Then
HasDependents = False
Else
HasDependents = (Err.Number = 0)
End If
.ShowDependents True
End With
End Function

 

[Jim Cone]

You have several syntax errors.
Add "Option Explicit" (without the quote marks) as the first line in your module.
--
Jim Cone
Portland, Oregon USA .
http://www.mediafire.com/PrimitiveSoftware .
(List Files XL add-in: finds and lists files/folders with hyperlinks)



"Jim" <[email protected]>
wrote in message

Below is a piece of code that I've been trying to modify. The code is
supposed to walk through the entire workbook and identify each cell
that has dependents. As I am working with a huge model, this would
take far too much time, and I would like to limit the macro to run
only a select few sheets. It would actually be even better if it only
ran on the active sheet, but I don't want to be picky. Any ideas?
=============================

-snip-

 

[Rick Rothstein]

The code is supposed to walk through the entire

workbook and identify each cell that has dependents.
As I am working with a huge model, this would take
far too much time, and I would like to limit the macro
to run only a select few sheets. It would actually be
even better if it only ran on the active sheet, but I
don't want to be picky.

Here is some code I have posted in the past, modified for your condition,
which will color the cells red. However, note that these cells are only the
ones in the UsedRange for the ActiveSheet. So if the used range was A1:F9
and you had a formula referencing A1:A100, only A1:A9 will get colored in.
It would take what seems like forever to search every cell on the worksheet
looking to see if it is a dependent cell or not.

Sub ColorDependentCellsOnActiveSheetRed()
Dim ShapeCount As Long, R As Range, DependantCells As Range
Application.ScreenUpdating = False
ActiveSheet.ClearArrows
ShapeCount = ActiveSheet.Shapes.Count
For Each R In ActiveSheet.UsedRange
R.ShowDependents
If ActiveSheet.Shapes.Count > ShapeCount Then
If DependantCells Is Nothing Then
Set DependantCells = R
Else
Set DependantCells = Union(R, DependantCells)
End If
End If
ActiveSheet.ClearArrows
Next
DependantCells.Interior.ColorIndex = 3
Application.ScreenUpdating = True
End Sub

Rick Rothstein (MVP - Excel)



"Jim" wrote in message

Below is a piece of code that I've been trying to modify. The code is
supposed to walk through the entire workbook and identify each cell
that has dependents. As I am working with a huge model, this would
take far too much time, and I would like to limit the macro to run
only a select few sheets. It would actually be even better if it only
ran on the active sheet, but I don't want to be picky. Any ideas?


=============================

Sub HighlightInputCells()

Dim wks As Worksheet
Dim rngFormulas As Range
Dim rngCell As Range
Dim vSheetLst As Variant

vSheetList = Array("Sheet2", "Sheet1")

Application.ScreenUpdating = False


For i = LBound(vSheetList) To UBound(vSheetList)
Worksheets(sheetlist(i)).Activate
On Error Resume Next
Set rngFormulas =
Union(wks.UsedRange.SpecialCells(xlCellTypeBlanks),
wks.UsedRange.SpecialCells(xlCellTypeConstants))
If Not rngFormulas Is Nothing Then
For Each rngCell In rngFormulas
If HasDependents(rngCell) Then rngCell.Interior.ColorIndex
= 3
Next rngCell
Set rngFormulas = Nothing
End If
Next wks
Application.ScreenUpdating = True

End Sub

Function HasDependents(rngCheck As Range) As Boolean
Dim lngSheetCounter As Long
Dim lngRefCounter As Long
Dim rngDep As Range

On Error Resume Next
With rngCheck
.ShowDependents False
Set rngDep = .NavigateArrow(False, 1, 1)
If rngDep.Address(external:=True) =
rngCheck.Address(external:=True) Then
HasDependents = False
Else
HasDependents = (Err.Number = 0)
End If
.ShowDependents True
End With
End Function