Question

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

I want that programmatically, because I want to get the precedents (or dependents) of a selection of cells.

Range.Dependents and Range.Precedents have other issues, but the solution there does not solve the extra-sheet issue.

Answer 1

After a fair bit of Googling I found it was solved in 2003.

But I used the code from here.

The problem is that Dependents and Precedents are Range properties, which can’t refer to multiple worksheets.

The solution uses NavigateArrow to locate the cross-sheet ‘dents.

Here’s my code:

Option Explicit

Private Sub GetOffSheetDents(ByVal doPrecedents As Boolean)

Dim c As Range
Dim results As Range
Dim r As Range
Dim sheet As Worksheet
Dim extra As Boolean

For Each c In Application.Intersect(ActiveSheet.UsedRange, Selection)
    Set r = oneCellDependents(c, doPrecedents)
    If Not r Is Nothing Then
        If r.Worksheet Is ActiveSheet Then
            ' skip it
        ElseIf sheet Is Nothing Then
            Set sheet = r.Worksheet
            Include results, r
        ElseIf Not sheet Is r.Worksheet Then
            If Not extra Then
                extra = True
                MsgBox "More than one external sheet in " & IIf(doPrecedents, "Precedents", "Dependents") & ". Only displaying first sheet."
            End If
        Else
            Include results, r
        End If
    End If
Next

If results Is Nothing Then
    Beep
Else
    results.Worksheet.Activate
    results.Select
End If
End Sub

Sub GetOffSheetDependents()

GetOffSheetDents False

End Sub

Sub GetOffSheetPrecedents()

GetOffSheetDents True

End Sub

Private Function Include(ByRef ToUnion As Range, ByVal Value As Range) As Range
If ToUnion Is Nothing Then
    Set ToUnion = Value
Else
    Set ToUnion = Application.Union(ToUnion, Value)
End If
Set Include = ToUnion
End Function

Private Function oneCellDependents(ByVal inRange As Range, Optional doPrecedents As Boolean) As Range

Dim inAddress As String, returnSelection As Range
Dim i As Long, pCount As Long, qCount As Long

If inRange.Cells.Count <> 1 Then Error.Raise 13

Rem remember selection
Set returnSelection = Selection
inAddress = fullAddress(inRange)

Application.ScreenUpdating = False
With inRange
    .ShowPrecedents
    .ShowDependents
    .NavigateArrow doPrecedents, 1
    Do Until fullAddress(ActiveCell) = inAddress
        pCount = pCount + 1
        .NavigateArrow doPrecedents, pCount
        If ActiveSheet.Name <> returnSelection.Parent.Name Then

            Do
                qCount = qCount + 1
                .NavigateArrow doPrecedents, pCount, qCount
                Include oneCellDependents, Selection
                On Error Resume Next
                .NavigateArrow doPrecedents, pCount, qCount + 1
                If Err.Number <> 0 Then _
                    Exit Do
                On Error GoTo 0
            Loop
            On Error GoTo 0
            .NavigateArrow doPrecedents, pCount + 1
        Else
            Include oneCellDependents, Selection
            .NavigateArrow doPrecedents, pCount + 1
        End If
    Loop
    .Parent.ClearArrows
End With

Rem return selection to where it was
With returnSelection
    .Parent.Activate
    .Select
End With
Application.ScreenUpdating = True

End Function

Private Function fullAddress(inRange As Range) As String
With inRange
    fullAddress = .Parent.Name & "!" & .Address
End With
End Function