Tracing precedents in external spreadsheets using Excel VBA

I'm currently trying to trace the dependencies of a complex set of Excel spreadsheets. My ideal end goal would be a tree structure, starting with my first spreadsheet. However, I don't want to include all of the dependencies of the child spreadsheets, just the ones of the cells referenced by the original spreadsheet. For example:

In cell A1 of my first workbook: somebook.xls!Sheet1!C2

I want to look at cell C2 in sheet 1 of somebook.xls for its (external) dependencies, and th开发者_StackOverflowen recurse.

At the moment I'm using LinkInfo to get a list of external dependencies, searching using Find, and I'm struggling with vbscript's primitive regex capabilities to try and extract the address out of the cells I find. This is not a brilliant way of doing things.

Does anyone know if Excel will tell you which cells in an external spreadsheet are being referenced? If not, any other tools that might help?

Thanks.

This answer is based off Bill Manville's macro from many years back. The macro still works, but I broke it out into functions allowing for more flexibility and reusability. The main addition by me is the ability to find external dependencies only, and the extension to both precedents and dependents. I also added a call to a custom macro called unhideAll; this was necessary for me as dependencies were not being found in hidden worksheets.

'Module for examining depedencies to/from a sheet from/to other sheets
Option Explicit

Sub showExternalDependents()
    Dim deps As Collection
    Set deps = findExternalDependents(ActiveCell)
    Call showDents(deps, True, "External Dependents: ")
End Sub

Sub showExternalPrecedents()
    Dim precs As Collection
    Set precs = findExternalPrecedents(ActiveCell)
    Call showDents(precs, True, "External Precedents: ")
End Sub

'external determines whether or not to print out the absolute address including workbook & worksheet
Sub showDents(dents As Collection, external As Boolean, header As String)
    Dim dent As Variant
    Dim stMsg As String
    stMsg = ""
    For Each dent In dents
        stMsg = stMsg & vbNewLine & dent.Address(external:=external)
    Next dent
    MsgBox header & stMsg
End Sub

Function findPrecedents(rng As Range) As Collection
    Set findPrecedents = findDents(rng, True)
End Function

Function findDependents(rng As Range) As Collection
    Set findDependents = findDents(rng, False)
End Function

Function findExternalPrecedents(rng As Range) As Collection
    Set findExternalPrecedents = findExternalDents(rng, True)
End Function

Function findExternalDependents(rng As Range) As Collection
    Set findExternalDependents = findExternalDents(rng, False)
End Function

'Gives back only the dependencies that are not on the same sheet as rng
Function findExternalDents(rng As Range, precDir As Boolean) As Collection
    Dim dents As New Collection
    Dim dent As Range
    Dim d As Variant
    Dim ws As Worksheet
    Set ws = rng.Worksheet
    For Each d In findDents(rng, precDir)
        Set dent = d
        With dent
        If Not (.Worksheet.Name = ws.Name And .Worksheet.Parent.Name = ws.Parent.Name) Then _
            dents.Add Item:=dent
        End With
    Next d
    Set findExternalDents = dents
End Function

'this procedure finds the cells which are the direct precedents/dependents of the active cell
'If precDir is true, then we look for precedents, else we look for dependents
Function findDents(rng As Range, precDir As Boolean) As Collection
    'Need to unhide sheets for external dependencies or the navigate arrow won't work
    Call mUnhideAll
    Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
    Dim dents As New Collection
    Dim bNewArrow As Boolean
    'Appliciation.ScreenUpdating = False
    If precDir Then
        ActiveCell.showPrecedents
    Else
        ActiveCell.ShowDependents
    End If
    Set rLast = rng
    iArrowNum = 1
    iLinkNum = 1
    bNewArrow = True
    Do
        Do
            Application.Goto rLast
            On Error Resume Next
            ActiveCell.NavigateArrow TowardPrecedent:=precDir, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
            If Err.Number > 0 Then Exit Do
            On Error GoTo 0
            If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
            bNewArrow = False
            dents.Add Item:=Selection
            iLinkNum = iLinkNum + 1 ' try another link
        Loop
        If bNewArrow Then Exit Do
        iLinkNum = 1
        bNewArrow = True
        iArrowNum = iArrowNum + 1 'try another arrow
    Loop
    rLast.Parent.ClearArrows
    Application.Goto rLast
    Set findDents = dents
End Function

Sub mUnhideAll()
'
' mUnhideAll Macro
'
    ' Unhide All
    Dim ws As Worksheet
    For Each ws In Worksheets
    ws.Visible = True
    Next
    
    'Sheets("Sprint Schedule Worksheet").Visible = False

End Sub

Excel's built in support, as you're finding, is limited and can be extremely frustrating.

In my experience, I've found a couple of tools from http://www.aivosto.com/ to be useful; Visustin v6 is especially useful for code related auditting/processing.

Here's a simpler version of Colm Bhandal's findDents and findExternalDents. It assumes all worksheets were made visible and arrows were cleared before use.

Function findDents(rCell As Range, bPrec As Boolean) As Collection
'Return all direct precedents (bPrec=True) or dependents (bPrec=False) of rCell
    Dim sAddr As String, nLink As Integer, nArrow As Integer
    Const bAbs As Boolean = False, bExt As Boolean = True
    Set findDents = New Collection
    If bPrec Then
        rCell.showPrecedents                ' even if rCell has no formula
    Else
        rCell.showDependents
    End If
    On Error Resume Next                    ' ignore errors
    sAddr = rCell.Address(bAbs, bAbs, xlA1, bExt)
    nArrow = 1
    Do
        nLink = 1
        Do
            rCell.NavigateArrow bPrec, nArrow, nLink
            If ActiveCell.Address(bAbs, bAbs, xlA1, bExt) = sAddr Then Exit Do
            findDents.Add Selection         ' possibly more than one cell
            nLink = nLink + 1
        Loop
        If nLink = 1 Then Exit Do
        nArrow = nArrow + 1
    Loop
    On Error GoTo 0
    If bPrec Then
        rCell.showPrecedents Remove:=True
    Else
        rCell.showDependents Remove:=True
    End If
End Function

Function findExternalDents(rCell As Range, bPrec As Boolean) As Collection
'Return ...Dents that are NOT in the same workbook and worksheet as rCell
    Dim rDent As Range, wsName As String, wbName As String
    With rCell.Worksheet: wsName = .Name: wbName = .Parent.Name: End With
    Set findExternalDents = New Collection
    For Each rDent In findDents(rCell, bPrec)
        If rDent.Worksheet.Name <> wsName Or rDent.Worksheet.Parent.Name <> wbName Then findExternalDents.Add Item:=rDent
    Next rDent
End Function

You might want to modify this to use a SortedList instead of a Collection. In that case, change

findDents.Add Selection

to

findDents.Add Selection.Address(bAbs, bAbs, xlA1, bExt), Null