Trace Dependents Loop

Hi

The code below colours all b1's dependents magenta this can be amended to delete or whatever

For Each t In Cells.Range("B1").Dependents
t.Interior.ColorIndex = 7
Next

Hope this Helps

Ed

You could use an input box to alter the range or hard code it to a different cell.

Ed

Try something like this. The sub below should mark any cells in TestRange that other cells depend on in magenta (thanks to Ed for earlier colour code). Only problem (which is a limitation of the Excel Dependents property) is that it won't find dependencies on other worksheets. You need to do much more work for that.

Sub MarkDependentCells(ByRef TestRange As Range)

'used to test
Dim t_range As Range
Dim this_cell As Range

'ok, loop through each cell
For Each this_cell In TestRange.Cells

'now test for dependents
Set t_range = Nothing
On Error Resume Next
Set t_range = this_cell.Dependents
On Error GoTo 0

'if there are any dependents then mark the cell in magenta
If Not (t_range Is Nothing) Then
this_cell.Interior.ColorIndex = 7
End If

Next

End Sub

Hope that helps!

Hi,

I have a product that can help you trace dependents cells. The product is ExcelSmartTools Auditor, and you can use the Iteractive Auditing command. You can download a free trial version at OzGrid site:

http://www.ozgrid.com/Services/ExcelSmartTools.htm

I hope you find this product useful
MGMoreira

You might try the free auditing add-in here: http://www.xl-logic.com/pages/explode.html

Not sure if it will do exactly what you want, but hopefully it will help.

How can you write a macro that would trace, or in this case color, dependent cells across worksheets?

Here is some code that will color the cells on the activesheet that refer to or are referred by cells on other sheets. You can adapt it for the whole workbook by having it loop through the workbook sheets you want marked. (I think I posted this on the forum some time ago, also.)
[vba]Const colorPrec As Integer = 35
Const colorDep As Integer = 36
Const colorBoth As Integer = 37

Sub ColorDirect()
'code will color cells on active sheet that have direct precedents or
'dependents on other sheets in the same workbook
Dim oldprotect As Boolean
Application.ScreenUpdating = False
oldprotect = ActiveSheet.ProtectContents
If oldprotect Then ActiveSheet.Unprotect
'remove old colors
Cells.Interior.ColorIndex = xlNone
doDependents
doPrecedents
If oldprotect Then ActiveSheet.Protect
End Sub

Private Sub doDependents()
'assumes ! in a formula means the formula depends on another sheet
Dim r As Range, c As Range, last As String
On Error Resume Next
Set r = Cells.SpecialCells(xlCellTypeFormulas)
If r Is Nothing Then Exit Sub
Set c = r.Find(What:="!", After:=r.Cells(1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If c Is Nothing Then Exit Sub
On Error GoTo 0
last = c.Address
Do
c.Interior.ColorIndex = colorDep
Set c = r.FindNext(c)
Loop Until c.Address = last
End Sub

Private Sub doPrecedents()
Dim s As String, r As Range, c As Range, last As String
Dim ws As Worksheet, oldprotect As Boolean
s = ActiveSheet.Name
If InStr(s, " ") > 0 Then s = s & "'!" Else s = s & "!"
For Each ws In Worksheets
If Not ws Is ActiveSheet Then
oldprotect = ws.ProtectContents
If oldprotect Then ws.Unprotect
On Error Resume Next
Set r = ws.Cells.SpecialCells(xlCellTypeFormulas)
If Not r Is Nothing Then
Set c = r.Find(What:=s, After:=r.Cells(1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not c Is Nothing Then
On Error GoTo 0
last = c.Address
Do
ColorCell c.Formula, s
Set c = r.FindNext(c)
Loop Until c.Address = last
End If
End If
If oldprotect Then ws.Protect
End If
Next ws
End Sub

Private Sub ColorCell(f As String, s As String)
Dim n As Integer, j As Integer, k As Integer, c As Range
n = Len(s)
j = InStr(f, s)
While j > 0 'may be more than one reference to activesheet in formula
j = j + n
'now get cell reference
k = j
While Mid(f, k, 1) <> "" And InStr("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ:", Mid(f, k, 1)) > 0
k = k + 1
Wend
For Each c In Range(Mid(f, j, k - j))
If c.Interior.ColorIndex = colorDep Then
c.Interior.ColorIndex = colorBoth
ElseIf c.Interior.ColorIndex = xlNone Then
c.Interior.ColorIndex = colorPrec
End If
Next c
f = Mid(f, k + 1)
j = InStr(f, s)
Wend
End Sub
[/vba]