Recursive VBA Precedents - vba

Question

I have an excel spreadsheet with quite a few formulas and data that I keep track of. I have a small macro that will find the Precedents for a selected cell however id like to make the macro recursive so that I can find all of the precedents. Eg Setting focus to a cell and running this function will highlight the cell and then highlight the precedents of the cell, then highlight the precedents of those cells, then highlight the precedents...
The problem I am having at the moment is I am not sure what the escape condition should be. I have ran into a few infinite loop problems and am not familiar with recursion enough to figure out a solid solution.
Below is some code that I am using to (correctly) find the inital precedents:
Sub FindClosedWbReferences(inRange As Range)
Rem fills the collection With closed precedents parsed from the formula String
Dim testString As String, returnStr As String, remnantStr As String
testString = inRange.Formula
testString = RemoveTextInDoubleQuotes(testString): Rem New line
Set ClosedWbRefs = New Collection
Do
returnStr = NextClosedWbRefStr(testString, remnantStr)
ClosedWbRefs.Add Item:=returnStr, Key:=CStr(ClosedWbRefs.count)
testString = remnantStr
inRange.Select
inRange.Interior.ColorIndex = 36
Loop Until returnStr = vbNullString
ClosedWbRefs.Remove ClosedWbRefs.count
End Sub
and this is called from a main function that looks similar to:
If homeCell.HasFormula Then
Set OtherWbRefs = New Collection: CountOfClosedWb = 0
Set SameWbOtherSheetRefs = New Collection
Set SameWbSameSheetRefs = New Collection
Rem find closed precedents from formula String
Call FindClosedWbReferences(homeCell)
Any help is appreciated. Thanks

Answer 1

As mentioned in my comments above, here is an example which will work for precedents in the same sheet. This will give you a start for finding precedents in other sheets as well.
Let's say, our Excel File looks like this (Sample File link mentioned in the end).
Cell A6 has the formula : =B6
Cell B6 has the formula : =C5+C7
Cell C5 has the formula : =D3+D4+D5
Cell C7 has the formula : =D7+D8+D9
'
' And so on. Cells, D4, D5, D8, D9, F3, G3, F9
' G9, G4:I4, G10:I10 do not have any formulas
I picked up the code from here and modified it further to suit my needs.
See this code
Dim rw As Long, col As Long
Dim ws As Worksheet
Dim fRange As Range
Sub Sample()
Set ws = ThisWorkbook.Sheets("Sheet1")
'~~> Clear cell for output
ws.Rows("20:" & ws.Rows.Count).Clear
'~~> Select First Cell
Set fRange = ws.Range("A6")
'~~> Set Row for Writing
rw = 20
FindPrecedents fRange
End Sub
Sub FindPrecedents(Rng As Range)
' written by Bill Manville
' With edits from PaulS
' With further edits by Me 14 Sept 2013
' this procedure finds the cells which are the direct precedents of the active cell
Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
Dim stMsg As String
Dim bNewArrow As Boolean
Application.ScreenUpdating = False
Rng.ShowPrecedents
Set rLast = Rng
iArrowNum = 1
iLinkNum = 1
bNewArrow = True
col = 1
ws.Cells(rw, col).Value = Rng.Address
col = col + 1
Do
Do
Application.Goto rLast
On Error Resume Next
ActiveCell.NavigateArrow TowardPrecedent:=True, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
If Err.Number > 0 Then Exit Do
On Error GoTo 0
If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
bNewArrow = False
ws.Cells(rw, col).Value = Selection.Address
col = col + 1
iLinkNum = iLinkNum + 1 ' try another link
Loop
If bNewArrow Then Exit Do
iLinkNum = 1: bNewArrow = True
iArrowNum = iArrowNum + 1 'try another arrow
Loop
rLast.Parent.ClearArrows
Application.Goto rLast
'~~> Write Output
If Len(Trim(ws.Cells(rw, 2).Value)) <> 0 Then
With ws
'~~> Find Last column in that row
lcol = .Cells(rw, .Columns.Count).End(xlToLeft).Column
j = rw + 1
For i = 2 To lcol
.Cells(j, 1).Value = .Cells(rw, i)
j = j + 1
Next i
End With
End If
rw = rw + 1
'~~> Here is where I am looping again
If Len(Trim(ws.Cells(rw, 1).Value)) <> 0 Then
FindPrecedents Range(ws.Cells(rw, 1).Value)
End If
End Sub
Output
Sample File
You can download the sample file from HERE to tinker with. Run the macro Sheet1.Sample()
If you want you can create further precedents for G4:I4, G10:I10 and test it :)