VBA: Determine All Precedent Cells – A Nice Example Of Recursion

I’ve been working on a project for this blog which I’ve found quite demanding. It’s taken me to parts of the Excel object model which I’ve never explored and challenged me to do some pretty difficult things. One aspect of the project I’ve just been looking at is how to programmatically determine all of the precedent cells for a given range.

Precedent cells are cells which are referenced by a formula and recognised in Excel’s calculation tree. If I have the formula =B2 in cell A1 then B2 is a precedent of cell A1. If I also have the formula =C3 in cell B2 then both B2 (first level) and C3 (second level) are precedents of cell A1.

It’s possible to trace precedents in the Excel GUI by clicking on the ‘Trace Precedents’ button on the Formulas tab on the Ribbon.

Unfortunately this isn’t so easy to do from VBA.

The first port of call in the Excel object model is the Range.Precedents property. According to the VBA help file it returns a Range object which represents a union of all of the precedent cells. Let’s give it a whirl:

Sub Test()

    Dim rngToCheck As Range
    Dim rngPrecedents As Range
    Dim rngPrecedent As Range

    Set rngToCheck = Range("A1")

    On Error Resume Next
    Set rngPrecedents = rngToCheck.Precedents
    On Error GoTo 0

    If rngPrecedents Is Nothing Then
        Debug.Print rngToCheck.Address(External:=True) & _
                    " has no precedents"
    Else
        For Each rngPrecedent In rngPrecedents
            Debug.Print rngPrecedent.Address(External:=True)
        Next rngPrecedent
    End If

End Sub

Output:

[Book1]Sheet1!$B$2
[Book1]Sheet1!$C$3

The output in the immediate window tells us it works with this simple example but what this example and the help file don’t tell us is that it doesn’t return precedents on other sheets or other workbooks. This restriction is enforced by the definition of the Range.Precedents property  because it returns a Range object and Range objects can’t reference ranges across different worksheets.

The solution that I know of to address the shortfalls of the Range.Precedents property  is to use the Range.ShowPrecedents() method to show the navigation arrows and then the Range.NavigateArrow() method to navigate along each of the arrows. This technique, which mimics the Excel GUI example we saw above, was first introduced to me in the good old days by Tim Critchley at XVBT.

Since then there have been improved variations of the technique built for different purposes but, despite scouring the internet, I couldn’t find an example which returned all precedents in all open workbooks. Fortunately for me I have access to a wide range of Excel experts and, with the advice of Mike Erickson and Rick Rothstein over at MrExcel, I adjusted this code posted by Andy Pope (originated from Bill Manville) to give this:

Sub Test2()

    Dim rngToCheck As Range
    Dim dicAllPrecedents As Object
    Dim i As Long

    Set rngToCheck = Sheet1.Range("A1")
    Set dicAllPrecedents = GetAllPrecedents(rngToCheck)

    Debug.Print "==="

    If dicAllPrecedents.Count = 0 Then
        Debug.Print rngToCheck.Address(External:=True); " has no precedent cells."
    Else
        For i = LBound(dicAllPrecedents.Keys) To UBound(dicAllPrecedents.Keys)
            Debug.Print "[ Level:"; dicAllPrecedents.Items()(i); "]";
            Debug.Print "[ Address: "; dicAllPrecedents.Keys()(i); " ]"
        Next i
    End If
    Debug.Print "==="

End Sub

'won't navigate through precedents in closed workbooks
'won't navigate through precedents in protected worksheets
'won't identify precedents on hidden sheets
Public Function GetAllPrecedents(ByRef rngToCheck As Range) As Object

    Const lngTOP_LEVEL As Long = 1
    Dim dicAllPrecedents As Object
    Dim strKey As String

    Set dicAllPrecedents = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False

    GetPrecedents rngToCheck, dicAllPrecedents, lngTOP_LEVEL
    Set GetAllPrecedents = dicAllPrecedents

    Application.ScreenUpdating = True

End Function

Private Sub GetPrecedents(ByRef rngToCheck As Range, ByRef dicAllPrecedents As Object, ByVal lngLevel As Long)

    Dim rngCell As Range
    Dim rngFormulas As Range

    If Not rngToCheck.Worksheet.ProtectContents Then
        If rngToCheck.Cells.CountLarge > 1 Then   'Change to .Count in XL 2003 or earlier
            On Error Resume Next
            Set rngFormulas = rngToCheck.SpecialCells(xlCellTypeFormulas)
            On Error GoTo 0
        Else
            If rngToCheck.HasFormula Then Set rngFormulas = rngToCheck
        End If

        If Not rngFormulas Is Nothing Then
            For Each rngCell In rngFormulas.Cells
                GetCellPrecedents rngCell, dicAllPrecedents, lngLevel
            Next rngCell
            rngFormulas.Worksheet.ClearArrows
        End If
    End If

End Sub

Private Sub GetCellPrecedents(ByRef rngCell As Range, ByRef dicAllPrecedents As Object, ByVal lngLevel As Long)

    Dim lngArrow As Long
    Dim lngLink As Long
    Dim blnNewArrow As Boolean
    Dim strPrecedentAddress As String
    Dim rngPrecedentRange As Range

    Do
        lngArrow = lngArrow + 1
        blnNewArrow = True
        lngLink = 0

        Do
            lngLink = lngLink + 1

            rngCell.ShowPrecedents

            On Error Resume Next
            Set rngPrecedentRange = rngCell.NavigateArrow(True, lngArrow, lngLink)

            If Err.Number <> 0 Then
                Exit Do
            End If

            On Error GoTo 0
            strPrecedentAddress = rngPrecedentRange.Address(False, False, xlA1, True)

            If strPrecedentAddress = rngCell.Address(False, False, xlA1, True) Then
                Exit Do
            Else

                blnNewArrow = False

                If Not dicAllPrecedents.Exists(strPrecedentAddress) Then
                    dicAllPrecedents.Add strPrecedentAddress, lngLevel
                    GetPrecedents rngPrecedentRange, dicAllPrecedents, lngLevel + 1
                End If
            End If
        Loop

        If blnNewArrow Then Exit Do
    Loop

End Sub

The GetAllPrecedents() function returns a Dictionary object containing range addresses in the keys and the precedent levels in the items. The most important concept in the code is recursion: the GetPrecedents() and GetCellPrecedents() call each other over and over until they run out of precedent cells. A simple enhancement to the code would be to add a limit to the number of levels it can go to: putting in a limit such as this is often required in recursive techniques.

Limitations and Caveats

The code won’t trace precedents through closed workbooks or protected sheets and it won’t find precedents in hidden sheets. I’m not worried about these limitations for the purposes of my project but it’s important to note that this approach is far from comprehensive. The bottom line is we need Microsoft to give us a new and improved Range class property which will give us a complete collection of all of the precedents. The same is true for dependents too.

The GetAllPrecedents() function may return overlapping addresses, for example B2:B10 and B4, because it uses unionised range addresses for efficiency purposes. When the code is navigating down a precedent tree, if it hits a cell which has been navigated before then it will ignore it. Again, this is for efficiency purposes. The function won’t work as a UDF because the Range.ShowPrecedents() and Range.NavigateArrows() methods are disabled when caller is a Range.

I use Range.CountLarge at one point in the code: if you are using Excel 2003 or earlier then this needs to be changed to Range.Count.

The return value of Range.SpecialCells() is limited to 8,192 non-contiguous cells in versions prior to Excel 2010. It is extremely unlikely that you will break this limit in this context.