In Excel Ctrl+[ or ] will sometimes directly switch to another sheet to show the precedents or dependents in that sheet.
I want that pro
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