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
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
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
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
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
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.
GetAllPrecedents() function may return overlapping addresses, for example
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.NavigateArrows() methods are disabled when caller is a
Range.CountLarge at one point in the code: if you are using Excel 2003 or earlier then this needs to be changed to
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.