Programmatically select other sheet precedents or dependents in Excel

Question

In Excel Ctrl+[ or ] will sometimes directly switch to another sheet to show the precedents or dependents in that sheet.

I want that pro

Answer 1

I found kaidobor's version of Mark Hurd's code exactly what I needed. I wrote a wrapper to document all the dependencies in the selected cells and insert them in a new sheet. My code just calls kaidobor's code and records the results.

My use case: I have a complex spreadsheet (written by someone else) that I need to clean up. I want to delete some sheets that appear unnecessary but want to know where I'll be breaking formulas before deleting the sheets. This will create an index showing all the cells that are referenced in other sheets.

Sub FindDependentsForThisSheet()
' Find all cells in the selection that have dependents on some other sheet
' Calls code by kaidobor
' January 9, 2017
Dim rCurrent As String, strNoDependents As String, strDependents As String, strCurrrentParent As String
Dim aDependents(1000, 4) As String ' Starting sheet, starting cell, referenced sheet, referenced cell
Dim intArrayRows As Long
strNoDependents = "No Dependents" & vbCrLf
strDependents = "Dependents" & vbCrLf
intArrayRows = 0
Application.ScreenUpdating = False

'Step through each cell in the current sheet (for each…)
For Each cell In Selection.Cells
    ' improvement: step through just the cells that are selected in case I know some are not worth bothering with
    Range(cell.Address).Select
    rCurrent = ActiveCell.Address
    strCurrrentParent = ActiveCell.Parent.Name
    'Run GetOffSheetDependents() for each cell
    GetOffSheetDependents
    'GetOffSheetPrecedents
    'When GetOffSheetDependents() is done, if the ActiveCell.Address is not changed,
    'If (rCurrent = ActiveCell.Address And strCurrrentParent = ActiveCell.Parent.Name) Then ' We do care about links on the current sheet
    If (strCurrrentParent = ActiveCell.Parent.Name) Then ' Do not care about links on the current sheet
        'then nothing
        strNoDependents = strNoDependents & ActiveCell.Parent.Name + " - " + ActiveCell.Address & vbCrLf
    Else
        ' Stuff the array
        aDependents(intArrayRows, 0) = strCurrrentParent
        aDependents(intArrayRows, 1) = rCurrent
        aDependents(intArrayRows, 2) = ActiveCell.Parent.Name
        aDependents(intArrayRows, 3) = ActiveCell.Address
        intArrayRows = intArrayRows + 1
        strDependents = strDependents + strCurrrentParent + "!" + rCurrent + " referenced in " + ActiveCell.Parent.Name + "!" + ActiveCell.Address & vbCrLf
        '1 record ActiveCell.Address + parent.
        '2 return to home sheet and
        Sheets(strCurrrentParent).Select
        '3 record the address of the active cell
    End If
    If intArrayRows > 999 Then
        MsgBox "Too many cells, aborting"
        Exit Sub
    End If
Next
'Debug.Print strDependents
'Debug.Print strNoDependents

' Store results in a new sheet
If intArrayRows > 0 Then
    varReturn = NewSheetandPaste(aDependents)
    MsgBox ("Finished looking for dependencies. Created sheet with results. Found this many: " & intArrayRows)
Else
    MsgBox ("Finished looking for dependencies, found none.")
End If
Application.ScreenUpdating = True
End Sub
' ************************************************************************************************

Function NewSheetandPaste(aPasteThis As Variant) '(strSheetName As String)
' Create new sheet and past strDependents
Dim strName As String, strStartSheetName As String, n As Long
'strName = strSheetName + "Dependents"
strStartSheetName = ActiveSheet.Name
strName = strStartSheetName + "Dependents"
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = strName
'Sheets("Sheet4").Name = "Sheet1Dependents"
Range("A1").Value = "Dependents from " + strStartSheetName
'ActiveCell.FormulaR1C1 = "Dependents from Sheet1"
'Range("A2").Value = strPasteThis
Range("A2").Value = "Starting Sheet"
Range("B2").Value = "Starting Sheet Cell"
Range("C2").Value = "Dependent Sheet"
Range("D2").Value = "Dependent Sheet Cell"

Range("A3").Select
intLengthArray = UBound(aPasteThis) - LBound(aPasteThis) + 1
n = 0
'For n = 0 To intLengthArray
While aPasteThis(n, 0) <> ""
    ActiveCell.Value = aPasteThis(n, 0)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = aPasteThis(n, 1)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = aPasteThis(n, 2)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = aPasteThis(n, 3)
    ActiveCell.Offset(1, -3).Select
    n = n + 1
Wend

NewSheetandPaste = True
End Function