Excel 2007: List all sheet references.

I received a bunch of workbooks that contain 40-80 worksheets full of data that all refer to each other. It's a mess. I would like to quickly understand what each sheet refers to. Will you please let me know what VBA code I can use to do the following: list each sheet followed by a list of other sheets it references too.

Please also include links/sources. Also many of the sheets contain over 30 columns with over 100,000 rows of data. If possible I would prefer a way to achieve this without iterating through each cell, as doing so, might take a very long time.

1: Sheet1<--- Sheet3
2: Sheet1<--- Sheet5
3: Sheet2<--- Sheet10
4: Sheet5<---Linked Sheet1: C:\Other\ExtraFiles\Backupsheet.xls

1: Says that Sheet 1 contains data from Sheet3
2: Says that Sheet 1 also contains data from Sheet 5
3: Says Sheet2 contains data from sheet 10
4: Says sheet5 contains data from sheet 1 of a linked workbook located at the following path: C:\Other\ExtraFiles\Backupsheet.xls
Who is Participating?
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:

attached is a workbook you can open and use to document other files that are Excel workbooks.  

there are 2 sheets:
1. FileList
      list of path\files to document  -- CUSTOMIZE
2. References
      this is appended to whenever the program is run -- delete the rows you no longer want to keep

there is 1 module containing a Sub called Excel_DocumentReferences. Run this to document the files listed on the FileList sheet -- external references, internal references to other sheets, and QueryTables.

here is the code:
Sub Excel_DocumentReferences()
'180114 crystal (strive4peace)
' license:  CC BY-NC-SA 3.0 (Creative Commons Attribution-NonCommercial-ShareAlike)

   'creates rows on the References sheet
   'based on what is found in files specified on the FileList sheet
   '  external references
   '  Internal references to other sheets
   '  QueryTables
   'FileList sheet
   '  A = Path\Filename to document
   'References sheet
      '1   A = Date/Time
      '2   B = Path\File
      '3   C = Note (ie: error)
      ' External
      '4   D = External Reference
      ' Internal
      '5   E = Sheet #
      '6   F = Sheet Name
      '7   G = Refers To
      ' Query Tables
      '8   G = Name
      '9   H = Connection
      '10  I = Type
   On Error GoTo Proc_Err

   Dim oWsFiles As Excel.Worksheet _
      , oWsReferences As Excel.Worksheet _
      , oWb As Excel.Workbook _
      , oWs As Excel.Worksheet _
      , oRange As Range _
      , oQueryTable As QueryTable
   Set oWsFiles = ThisWorkbook.Sheets("FileList")
   Set oWsReferences = ThisWorkbook.Sheets("References")
   Dim nRow2_Files As Long _
      , nCol2_Reference As Long _
      , nRow_Reference As Long _
      , nRow_File As Long _
      , sPathFile As String _
      , iNumSheets As Integer _
      , iQueryType As Integer _
      , i As Integer _
      , j As Integer _
      , vLinks As Variant
   Dim asSheetname() As String _
      , aiSheetIndex() As Integer _
      , asLookfor(1 To 2) As String _
      , asQueryType(1 To 7) As String
   asQueryType(1) = "ODBC"
   asQueryType(2) = "DAO"
   asQueryType(3) = "3"
   asQueryType(4) = "Web"
   asQueryType(5) = "OleDB"
   asQueryType(6) = "Text"
   asQueryType(7) = "ADO"
   nRow_File = 2 'assume first file is on row 2
   With oWsFiles
      'last row to read
      nRow2_Files = .Cells(.Rows.Count, 1).End(xlUp).Row + 1   'xlUp=-4162
      'Last Column of Data
      nRow2_Files = .Cells(.Columns.Count, 1).End(xlToLeft).Row + 1 ''xlToLeft=-4159
   End With

   With oWsReferences

      'last row with information
      nRow_Reference = .Cells(.Rows.Count, 1).End(xlUp).Row  'xlUp=-4162
      'first row has merged cells
      'second row (2) is column headers
      nCol2_Reference = .Cells(2, .Columns.Count).End(xlToLeft).Column  'xlToLeft=-4159
   End With
   'write label row for this batch of files
   With oWsReferences
      nRow_Reference = nRow_Reference + 1
      .Cells(nRow_Reference, 1) = Date
      With .Range(.Cells(nRow_Reference, 1), .Cells(nRow_Reference, nCol2_Reference))
         'Bold Date/Time and Path\File
         .Font.Bold = True
         'border line above
         With .Borders(xlEdgeTop) 'xlEdgeTop=8
             .LineStyle = xlContinuous 'xlContinuous=1
             .Color = RGB(150, 150, 150)
             .Weight = xlThick 'xlThick=4
         End With
          .Interior.Color = RGB(200, 200, 200) 'gray
      End With
   End With
   Do While nRow_File <= nRow2_Files
      'get name of file to open
      With oWsFiles
         sPathFile = .Cells(nRow_File, 1)
         If sPathFile = "" Then
            GoTo NextFile
         End If
      End With
      'title row in References Sheet
      With oWsReferences
         nRow_Reference = nRow_Reference + 1
         .Cells(nRow_Reference, 1) = Now()
         .Cells(nRow_Reference, 2) = sPathFile
         With .Range(.Cells(nRow_Reference, 1), .Cells(nRow_Reference, 2))
            'Bold Date/Time and Path\File
            .Font.Bold = True
            'background color = light yellow
             .Interior.Color = RGB(255, 255, 220)
         End With
      End With
      'open workbook - don't update links, open read-only
      On Error Resume Next
      Set oWb = Workbooks.Open(sPathFile, False, True)
      If Err.Number > 0 Then
         oWsReferences.Cells(nRow_Reference, 3) = _
            "Error " & Err.Number & " " & Err.Description
         GoTo NextFile
         On Error GoTo Proc_Err
      End If
      '------------------------------- External References
      vLinks = oWb.LinkSources(xlExcelLinks)
      If Not IsEmpty(vLinks) Then
         With oWsReferences
            For i = LBound(vLinks) To UBound(vLinks)
               'next row of reference sheet
               nRow_Reference = nRow_Reference + 1
               .Cells(nRow_Reference, 1) = Now()
               .Cells(nRow_Reference, 2) = sPathFile
               .Cells(nRow_Reference, 4) = vLinks(i)
               'make repeated information gray
               .Range(.Cells(nRow_Reference, 1), .Cells(nRow_Reference, 2)).Font.Color = RGB(150, 150, 150)
            Next i
         End With 'oWsReferences
      End If

      'clear previous sheetname arrays
      Erase asSheetname
      Erase aiSheetIndex
      'load an array with all the sheet names
      With oWb
         iNumSheets = oWb.Sheets.Count
         ReDim asSheetname(1 To iNumSheets)
         ReDim aiSheetIndex(1 To iNumSheets)
         i = 1
         For Each oWs In oWb.Sheets
            asSheetname(i) = oWs.Name
            aiSheetIndex(i) = oWs.Index 'used for faster comparison
            i = i + 1
         Next oWs
      End With
      'loop through sheets
      For Each oWs In oWb.Sheets

         '------------------------------- Internal Reference to another sheet
         For i = 1 To iNumSheets
            'skip looking if sheet is what we are on
            If oWs.Index <> aiSheetIndex(i) Then
               'look for sheetname! or 'sheet name'!
               asLookfor(1) = asSheetname(i) & "!"
               asLookfor(2) = "'" & asSheetname(i) & "'!"
               With oWs
                  For j = 1 To 2
                     'look for sheet name in part of formula
                     Set oRange = oWs.UsedRange.Find( _
                        What:=asLookfor(j) _
                        , LookIn:=xlFormulas _
                        , LookAt:=xlPart)
                     If Not oRange Is Nothing Then
                        nRow_Reference = nRow_Reference + 1
                        With oWsReferences
                           .Cells(nRow_Reference, 1) = Now()
                           .Cells(nRow_Reference, 2) = sPathFile
                           'make repeated information gray
                           .Range(.Cells(nRow_Reference, 1), .Cells(nRow_Reference, 2)).Font.Color = RGB(150, 150, 150)
                           .Cells(nRow_Reference, 5) = aiSheetIndex(i)
                           .Cells(nRow_Reference, 6) = oWs.Name
                           .Cells(nRow_Reference, 7) = asSheetname(i)
                        End With 'oWsReferences
                        GoTo NextSheetLookFor
                     End If
                  Next j 'look for
               End With 'oWs
            End If 'sheet name different
         Next i 'loop to find other sheet references in this sheet
         'document Query Tables
         For Each oQueryTable In oWs.QueryTables  '1st is Sheet1_Change
            With oQueryTable
               nRow_Reference = nRow_Reference + 1
               oWsReferences.Cells(nRow_Reference, 8) = .Name
               oWsReferences.Cells(nRow_Reference, 9) = .Connection
               iQueryType = .QueryType
               If iQueryType < LBound(asQueryType) Or iQueryType > UBound(asQueryType) Then
                  oWsReferences.Cells(nRow_Reference, 10) = .QueryType
                  oWsReferences.Cells(nRow_Reference, 10) = asQueryType(.QueryType)
               End If
            End With
         Next oQueryTable
      Next oWs

      'close without saving (opened read-only so won't be saved anyway)
      oWb.Close False

      On Error GoTo Proc_Err 'in case we got here because of an error
      nRow_File = nRow_File + 1
   Set oWb = Nothing
   'make References sheet active
   With oWsReferences
      .Cells(3, 1).Select
       'best-fit columns
      .Range(.Columns(1), .Columns(.UsedRange.Columns.Count)).EntireColumn.AutoFit
   End With
    'freeze panes and turn on the auto filter 
   ActiveWindow.FreezePanes = True
   MsgBox "Done"
   On Error Resume Next
   Set oRange = Nothing
   Set oWsFiles = Nothing
   Set oWsReferences = Nothing
   Set oWs = Nothing 
   If Not oWb Is Nothing Then
      oWb.Close False
      Set oWb = Nothing
   End If
   Exit Sub
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   Excel_DocumentReferences"

   Resume Proc_Exit

End Sub

Open in new window

The error handling code is based on this EE video:

(there are 2 other videos in this series if you wish to know more)

have an awesome day,
You can test this sub (run from module):
Public Sub FindText()
Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String

myText = "!"

For Each ws In ThisWorkbook.Worksheets
    With ws.UsedRange

        Set Found = .Find(myText, , xlFormulas, xlPart)
        Debug.Print ws.Name
        If Not Found Is Nothing Then
        FirstAddress = Found.Address

                Debug.Print Found.Address & " - " & Found.Formula

                Set Found = .FindNext(Found)

            Loop While Not Found Is Nothing And Found.Address <> FirstAddress
        End If

    End With

Next ws

End Sub

Open in new window

ouestqueAuthor Commented:
Thank you everyone. Great answers!!
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
you're welcome ~ happy to help
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.