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.

Example:
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
ouestqueAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

als315Commented:
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

            Do
                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

0
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
hi,

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
      Results
      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
   
   'DOCUMENTS:
   '  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
      Err.Clear
      Set oWb = Workbooks.Open(sPathFile, False, True)
      If Err.Number > 0 Then
         oWsReferences.Cells(nRow_Reference, 3) = _
            "Error " & Err.Number & " " & Err.Description
         GoTo NextFile
      Else
         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
                     'xlFormulas=-4123
                     'xlPart=2
                     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
            
NextSheetLookFor:
         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
               Else
                  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

NextFile:
      On Error GoTo Proc_Err 'in case we got here because of an error
      nRow_File = nRow_File + 1
   Loop
   
   Set oWb = Nothing
   
   'make References sheet active
   oWsReferences.Parent.Activate
   oWsReferences.Select
   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
   Selection.AutoFilter
 
   MsgBox "Done"
   
Proc_Exit:
   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
  
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   Excel_DocumentReferences"

   Resume Proc_Exit
   Resume

End Sub

Open in new window


The error handling code is based on this EE video:

https://www.experts-exchange.com/videos/1478/Basic-Error-Handling-code-for-VBA-and-Microsoft-Office.html
(there are 2 other videos in this series if you wish to know more)


have an awesome day,
crystal
Excel_DocumentLinks_180114_5p_s4p.xlsm
2

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ouestqueAuthor Commented:
Thank you everyone. Great answers!!
0
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
you're welcome ~ happy to help
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.