Identify all sheets related to one sheet

[jazmin]

Hi:
I have been given an excel model to review;the workbook has 53 sheets. I would like to know if there is a way to create a flowchart/matrix with the relation of all the sheets. I would like at least to get a list of all the sheets related to each sheet. All what I was able to do is to get all the sheet names in one sheet. (I am using Excel 2003)
Many thanks!!

 

[Peter_SSs]

Welcome to the MrExcel board!

Not sure if this is more (or less) than you want or if there may be an easier way.

I would suggest testing in a copy of a workbook that has a relatively small number of sheets and links.

It only attempts to check for formula links between sheets of the workbook itself, not for links to other workbooks.

If any of your sheets are large and may have more than 8,192 separate areas of formulas, then further work will be required. Ref: http://www.rondebruin.nl/specialcells.htm

Anyway, give it a try.

Sub List_Worksheet_Links()
  Dim wsList As Worksheet, ws As Worksheet
  Dim i As Long, j As Long, nr As Long
  Dim frmlacells As Range, c As Range
  Dim RX As Object, ary As Object
  Dim s As String, t As String, fsname As String, Pat As String
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  On Error Resume Next
  Sheets("Link List").Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
  For Each ws In ThisWorkbook.Worksheets
    Pat = Pat & "'*|'*" & ws.Name
  Next ws
  Pat = "(" & Replace(Pat, "'*|", "", 1, 1, 1) & "'*)(?=\!)"
  Set RX = CreateObject("VBscript.Regexp")
  With RX
    .Global = True
    .Pattern = Pat
  End With
  Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Link List"
  Set wsList = ActiveSheet
  wsList.Range("A1:E1").Value = Array("Formula Sheet", "Cell", "Sheet(s) Linked To", "Formula", "Formula Result")
  wsList.Columns("A:D").NumberFormat = "@"
  nr = 1
  For i = 1 To Sheets.Count - 1
    fsname = Sheets(i).Name
    Set frmlacells = Nothing
    On Error Resume Next
    Set frmlacells = Sheets(i).UsedRange.SpecialCells(xlFormulas)
    On Error GoTo 0
    If Not frmlacells Is Nothing Then
      For Each c In frmlacells
        s = Replace(c.Formula, "=", "", 1, 1, 1)
        If RX.Test(s) Then
          t = ""
          Set ary = RX.Execute(s)
          For j = 0 To ary.Count - 1
            t = t & ", " & ary(j)
          Next j
          nr = nr + 1
          t = Replace(Replace(t, ", ", "", 1, 1, 1), "'", "", 1, -1, 1)
          With wsList.Cells(nr, 1)
            .Value = fsname
            .Offset(, 1).Value = c.Address(0, 0)
            .Offset(, 2).Value = t
            .Offset(, 3).Value = "=" & s
            .Offset(, 4).Value = c.Value
          End With
        End If
      Next c
    End If
  Next i
  wsList.Columns("A:E").AutoFit
  Application.ScreenUpdating = True
End Sub

It should return results along these lines on a separate 'Link List' sheet:

Excel Workbook
	A	B	C	D	E
1	Formula Sheet	Cell	Sheet(s) Linked To	Formula	Formula Result
2	Main Data	A1	Summary	=Summary!A1+5	168.1
3	Main Data	B6	xyz, Some other sheet name	=A1&" "&xyz!B2&" "&'Some other sheet name'!F4	168.1 dollars spent this week
4	Summary	A1	abc, xyz	=abc!A1*xyz!F4	163.1
5	abc	B4	xyz	=xyz!F4	23.3
Link List

 

[jazmin]

Hi Peter:

Thanks so much. That will help me a lot!!!

Jazmin