Trace Dependents Loop

  • I am trying to devise a macro that would identify cells that are dependents and am encountering great difficulty.

    My problem is when I run my macro I get only the first dependent to be highlighted and nothing else in the range, even if it is a dependent, shows up as being dependent.

    I have huge spreadsheets with a lot of information that can be cut out, so I think this macro would help identify some of my waste in these spreadsheets.

    So if you have any suggestions or code to try please let me know.


  • 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

    Hope this Helps

    Ed :P

  • Ed,

    Do you mind sharing some code that would work, b/c I am not getting it to work at all.

    Let's just say you want a macro that would tell you (by highlighting the cell a color or by bolding it, etc.) all cells in B1:B10 that are dependents, ie used elsewhere in the worksheet.

    Let's say cells 2, 4, 6, 8, and 10 are dependents so those cells should have some type of format change to them.

    My problem is 2 fold: I either get an error message off the bat saying cell 1 is not dependent and my code stops or I only get cell 2 to be highlighted and it misses all my other cells (4,6,8, and 10 in my example).

    If you would be so kind as to provide a code that I could copy and paste into VBA editor and than tweak that would be much appreciated.


  • I didn't mean to be caring a conversation exclusively with Ed here. If anyone else knows a macro/code that would do the trick please let me know.


  • 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


    End Sub

    Hope that helps!

  • MGMoreira,

    I downloaded your add-in and it looks like something more than what I need. I am not sure I understand exactly how to use it.

    If you refer to my post of Jan 28, this is the problem I am encountering. I have huge spreadsheets, greater than 10 MB, but a lot of the spreadsheet is waste. I want to know which cells I can delete by running a simple macro to tell me if the cell is dependent on anything.

    How would I use your add in for that? Again, say cells B2, 4, 6, 8, 10 are dependents. And Cells B1, 3,5, 7, 9 are a combination of empty cells, numbers, and characters.


  • 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
    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
    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, _
    If Not c Is Nothing Then
    On Error GoTo 0
    last = c.Address
    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
    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)
    End Sub

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!