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.

Precedents GUI

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.

Advertisements

About Colin Legg

RAD Developer Microsoft MVP - Excel 2009 - 2014
This entry was posted in Microsoft Excel and tagged , , , , . Bookmark the permalink.

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

  1. Jeff Weir says:

    Nice work. I guess another way to do this would be to check if a cell contains a formula, then parse out the precedents directly from the formula text of each cell.

    Like

  2. Jeff Weir says:

    …or use Jan Karel Pieterse’s excellent addin “reftree analyser”
    http://dailydoseofexcel.com/archives/2014/01/14/formula-auditing-by-reftreeanalyser-objects-included/

    Like

  3. Timid e says:

    Nice work Colin, good to see something a bit more structured than the original offering – looks tight!

    Like

  4. Doug Glancy says:

    I had never noticed CountLarge before. According to Excel Help it “counts the largest value in a given Range of values,” which is clearly not true.

    I hadn’t visited your blog in a while. Good stuff!

    Liked by 1 person

    • Colin Legg says:

      Hi Doug,

      Glad to see you back here!

      That’s a real shocker in the Excel VBA helpfile – nice catch. I’ll do a quick blog post on Range.CountLarge so watch this space. :)

      Regards,
      Colin

      Like

  5. Pingback: An Overview Of Range.CountLarge | RAD Excel

  6. Kintaar says:

    Thanks for posting this. It has been very helpful for something I’m working on, and it is a nice starting point for finding precedent cells in light of Microsoft’s reluctance to fix the shortcomings of the Range object. I share your frustration! However, I believe there is a bug in the algorithm that pertains to the levels that it calculates. This code demonstrates the bug. I have rewritten the code to fix this and a few other things, and I will send it to you if you’d like.

    Sub Test3()
    Dim rngToCheck As Range
    Dim dicAllPrecedents As Object
    Dim i As Long

    ‘ Set up the spreadsheet.
    Worksheets(“Sheet1”).Range(“A3”).Value = 3
    Worksheets(“Sheet1”).Range(“B3”).Formula = “=A3-1”
    Worksheets(“Sheet1”).Range(“C3”).Formula = “=B3-1”
    ‘ The only difference is that B3 and C3 are transposed.
    Worksheets(“Sheet1”).Range(“F3”).Formula = “=B3+C3”
    Worksheets(“Sheet1”).Range(“G3”).Formula = “=C3+B3”

    ‘ Test F3.
    Set rngToCheck = Worksheets(“Sheet1”).Range(“F3”)
    Set dicAllPrecedents = GetAllPrecedents(rngToCheck)
    Debug.Print “=== Results for F3 show the right levels.”
    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 “===” & vbCrLf

    ‘ Test G3.
    Set rngToCheck = Worksheets(“Sheet1”).Range(“G3”)
    Set dicAllPrecedents = GetAllPrecedents(rngToCheck)
    Debug.Print “=== Results for G3 show the wrong levels for A3 and B3.”
    Debug.Print ” C3 depends on B3, but they are both at level 1.”
    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

    Like

    • Colin Legg says:

      Hi, yes you’re correct. I alluded to this in the limitations/caveats section of my post when I mentioned that it will ignore a precedent cell if that cell has been navigated to before. When I wrote the code my mandate was to identify the cells – I wasn’t concerned with the levels or level conflicts between different navigation paths. If you’ve got some more thorough code which handles that and gives every complete path then please send it to me so I can share it or, alternatively, we could organise for you to present it in a guest author post on here? Thanks, Colin.

      Like

      • kintaar says:

        The guest author post sounds like a great idea. I’m working on a macro that needs to run quickly, and one way to speed it up is to turn off automatic calculations while it’s running. A macro to locate precedents and recalculate them in the correct order is essential, so perhaps that could be the topic.

        Like

  7. jimsjoo says:

    Thanks to this post, I just hit upon a good idea how to draw vertices and edges of MST(Minimal Spanning Tree) on a worksheet. At first I had considered shapes and lines for the vertices and edges. Thanks for your inspiring posting.

    Like

  8. Roger W says:

    I ran into Horrible overhead due to the number of arrows being shown due to the recursion, so I refactored it to collect all the precedent ranges in one go, then hide the arrows again.

    
    Private Function GetAllPrecedentsForCell(rngCell As Range) As Range()
        rngCell.Worksheet.ClearArrows
        Dim lngArrow As Long
        Dim lngLink As Long
        Dim blnNewArrow As Boolean
        Dim rngPrecedentRange As Range
        Dim strPrecedentAddress As String
        Dim strAddress As String
        
        Dim s() As Range
        Dim ix As Long
        
        
        ReDim s(0)
        Set s(0) = Nothing
        lngArrow = 0
        strAddress = rngCell.Address(False, False, xlA1, True)
        rngCell.ShowPrecedents
        Do
            lngArrow = lngArrow + 1
            blnNewArrow = True
            lngLink = 0
     
            Do
                lngLink = lngLink + 1
                On Error Resume Next
                'rngCell.Worksheet.Activate
                'rngCell.Activate
                'rngCell.ShowPrecedents
                Set rngPrecedentRange = rngCell.NavigateArrow(True, lngArrow, lngLink)
     
                If Err.Number <> 0 Then
                    Err.Clear
                    Exit Do
                End If
                On Error GoTo 0
                
                strPrecedentAddress = rngPrecedentRange.Address(False, False, xlA1, True)
                If strPrecedentAddress = strAddress Then
                    Exit Do
                End If
                blnNewArrow = False
                ix = UBound(s)
                If Not (s(ix) Is Nothing) Then
                    ix = ix + 1
                    ReDim Preserve s(0 To ix)
                End If
                Set s(ix) = rngPrecedentRange
            Loop
            If blnNewArrow Then
                Exit Do
            End If
        Loop
        rngCell.ShowPrecedents True
        rngCell.Worksheet.ClearArrows
        
        GetAllPrecedentsForCell = s
    End Function
    

    Like

  9. Colin Legg says:

    Thanks for sharing it, Roger.

    Like

  10. Kevin Briere says:

    Hello – I’ve been trying to find a slick macro to improve the trace precedents function in Excel. I copies this script, but when I run the macro it doesn’t seem to work.

    Like

  11. Colin Legg says:

    Jeff points out at Daily Dose Of Excel that this code won’t pick up precedents in tables on other sheets.

    Like

  12. Pingback: Daily Dose of Excel » Blog Archive » Formula Auditing – woes and arrows

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s