none
How to List External Dependents for a Worksheet RRS feed

  • Question

  • I would like to develop a macro that lists all external dependents for a worksheet (or the current slection perhaps).

    I have found some code that will list them for a cell that has dependents (internal or external) but it goes into an infinte loop for cells that have no dependents and I can't find a satisfacory way to fix that.

    The basic code (by Chris Spicer) is shown below. I have added a macro the calls this code for every cell in the current selection. It works until it encounters a cell with no references, at which point it goes into an inifite loop, only breaking out when a counter that I am using in, the calling macro, reaches 32768.

    I think the problem is that the code relies on error trapping and it seems that if there are no dependents at all in a cell, no errors are generated. I have tried, in my calling macro, to detect whether or not a cell has dependents before calling the code but that seems frustraiingly difficult to do. The Depenents property for example, only detect ineteral dependents.

    Any suggestions woud be very much appreciated.

    Option Explicit
    
    Public Sub FindExternalDependents(byVal rngPrecedent As Range)
        ' Find all of the cells that are dependent on the precedent cell,
       ' but are on a different sheet to the precedent cell.
       
        ' We'll be checking for errors as we go
       On Error Resume Next
        
        ' Show the dependency arrows
       rngPrecedent.ShowDependents
        
        
        Dim arrowNumber As Integer
        arrowNumber = 1
        
        ' We'll break out of this loop when
       ' no more dependencies are found.
       Do
            rngPrecedent.NavigateArrow False, arrowNumber, 1
            
            If Err.Number <> 0 Then
                GoTo NoMoreArrows
            Else
                Debug.Print "Dependent found at " + Selection.Address(External:=True)
                CheckForExternalLinks rngPrecedent, arrowNumber
                
                ' Check the next arrow.
               arrowNumber = arrowNumber + 1
            End If
        Loop While True
        
    NoMoreArrows:
        Exit Sub
    End Sub
    
    Private Sub CheckForExternalLinks(ByVal rngPrecedent As Range, ByVal arrowNumber As Integer)
        ' One arrow is the external links arrow.  Follow all of its links.
       Dim linkNumber As Integer
        linkNumber = 2
        
        Do
            rngPrecedent.NavigateArrow False, arrowNumber, linkNumber
            
            If Err.Number <> 0 Then
                GoTo NoMoreArrows
            Else
                Debug.Print "Dependent found at " + Selection.Address(External:=True)
                
                ' Check the next link
               linkNumber = linkNumber + 1
            End If
        Loop While True
    
    NoMoreArrows:
        Exit Sub
    End Sub


    R Campbell

    Wednesday, September 16, 2015 11:11 PM

Answers

  • The code below appears to work. It seems that, for cells that don't have external dependents, the code returns the address of the cell itself, without generating an error. I have used that fact to escape from the infinite loop that would otherwise result. Merged cells were a problem but that was easily fixed.

    One day I will set this up with three calling macros that can list precndents, dependents or both.

    Option Explicit
    Dim CellCount As Integer
    Dim EndFlag As Boolean
    Sub aListExternalLinks()
        CellCount = 0
        Application.ScreenUpdating = False
        Dim oCell As Object
        For Each oCell In Selection
            EndFlag = False
            aFindExternalDependents oCell, "Ext"
        Next oCell
        ActiveSheet.ClearArrows
        Application.ScreenUpdating = True
        MsgBox CStr(CellCount) & " External References Found", vbOKOnly
    End Sub
    Public Sub aFindExternalDependents(ByVal rngPrecedent As Range, ShowWhat As String)
       On Error Resume Next
       rngPrecedent.ShowDependents
        Dim ArrowNumber As Integer
        ArrowNumber = 1
        
        Do
             rngPrecedent.NavigateArrow False, ArrowNumber, 1
             If Err.Number <> 0 Or EndFlag Then
                 GoTo NoMoreArrows
             Else
                 Debug.Print "Dependent found at " + Selection.Address(External:=True)
                 CheckForExternalLinks rngPrecedent, ArrowNumber
                ArrowNumber = ArrowNumber + 1
             End If
         Loop While True
        
    NoMoreArrows:
        Exit Sub
    End Sub
    
    Private Sub CheckForExternalLinks(ByVal rngPrecedent As Range, ByVal ArrowNumber As Integer)
       Dim linkNumber As Integer
       Dim CurrAddr, LinkAddr As String
    
        CurrAddr = "'[" & ActiveWorkbook.Name & "]" & ActiveSheet.Name & "'!" & rngPrecedent.MergeArea.Address(True, True, xlA1)
      
        linkNumber = 2
        
        Do
            rngPrecedent.NavigateArrow False, ArrowNumber, linkNumber
            If Err.Number <> 0 Then
                GoTo NoMoreArrows
            Else
                LinkAddr = Selection.Address(External:=True)
                If LinkAddr <> CurrAddr Then
                    Debug.Print rngPrecedent.MergeArea.Address(False, False, xlA1) & ",Ext," & LinkAddr & " linkNumber: " & CStr(linkNumber)
                    CellCount = CellCount + 1
                Else
                    EndFlag = True
                    GoTo NoMoreArrows
                End If
                linkNumber = linkNumber + 1
            End If
        Loop While True
    
    NoMoreArrows:
        Exit Sub
    End Sub
     


    R Campbell


    • Edited by Dick Campbell Thursday, September 17, 2015 1:49 PM
    • Marked as answer by Dick Campbell Thursday, September 17, 2015 8:11 PM
    Thursday, September 17, 2015 1:48 PM