speed up Excel off-sheet dependents search - vba

Question

I've incorporated the off-sheet dependents search using the "ShowDependents" and "NavigateArrow" VBA methods. Everything works well but it is just painfully slow (for a large number of dependents).
Are there alternatives, way to speed it up? I've tried disabling the ScreenUpdating but that doesn't speed it up by much.
This is what my code is based on: http://www.technicana.com/vba-for-checking-dependencies-on-another-sheet

Answer 1

Consider the following function which is supposed to return true if the cell you pass it has a direct dependent on a different sheet:
Function LeadsOut(c As Range) As Boolean
Application.ScreenUpdating = False
Dim i As Long, target As Range
Dim ws As Worksheet
Set ws = ActiveSheet
c.ShowDependents
On Error GoTo return_false
i = 1
Do While True
Set target = c.NavigateArrow(False, i)
If c.Parent.Name <> target.Parent.Name Then
ws.Select
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
LeadsOut = True
Exit Function
End If
i = i + 1
Loop
return_false:
LeadsOut = False
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
End Function
Sub test()
MsgBox LeadsOut(Selection)
End Sub
To test it, I linked the test sub to a command button on Sheet1.
In A2 I entered the formula = A1 + 1, with no other formulas on Sheet1.
On Sheet2 I entered the formula =Sheet1!A2.
Back on Sheet1, if I select A2 and invoke the sub it almost instantly pops up "True". But if I select A1 and invoke the sub it returns "False" -- but only after a delay of several seconds.
To debug it, I put a Debug.Print i right before i = i + 1 in the loop. The Immediate Window, after running it again, looks like:
32764
32765
32766
32767
Weird!!!!!
I was utterly stumped until I replaced Debug.Print i by
Debug.Print target.Address(External:=True)
Which led to output that looks ends like:
[dependents.xlsm]Sheet1!$A$1
[dependents.xlsm]Sheet1!$A$1
[dependents.xlsm]Sheet1!$A$1
[dependents.xlsm]Sheet1!$A$1
NavigateArrow(False,i) goes back to the originating cell and stays there once i exceeds the number of dependents! This is seemingly undocumented and massively annoying. The code you linked to was written by someone who hasn't discovered this. As a kludge, you should check that when you are navigating arrows you haven't returned to the starting point. The following seems to work almost instantly in all cases, although I haven't tested it very much:
Function LeadsOut(c As Range) As Boolean
Application.ScreenUpdating = False
Dim i As Long, target As Range
Dim ws As Worksheet
Set ws = ActiveSheet
c.ShowDependents
On Error GoTo return_false
i = 1
Do While True
Set target = c.NavigateArrow(False, i)
If target.Address(External:=True) = c.Address(External:=True) Then
GoTo return_false
End If
If c.Parent.Name <> target.Parent.Name Then
ws.Select
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
LeadsOut = True
Exit Function
End If
i = i + 1
Loop
return_false:
LeadsOut = False
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
End Function
The key lines are the three lines which begin
If target.Address(External:=True) = c.Address(External:=True)
Adding some such check in the sub you linked to should make a massive difference.