How to get first cell which is referred to formula and last cell which refers to formula in Excel worksheet?

In the situation that you had to parse worksheet with much formula, what would you do? You would trace formula to first cell which has no reference. In this article, I’d like to describe to find the first cells with wading through spaghetti formula.

In order to demonstrate that set A is equal to set B, you should demonstrate that the union is equal to the intersection.

When you compare DirectPrecendents property and Precendents property, which refer to direct reference range and all reference range, respectively, if the former is equal to the later, the range is the first cell. It’s assumed that no range refers to other worksheets and they have no cyclic references.

You could constitute tree structure from first cell to last cell or from the last to the first, respectively. It’s a common technique to configure deployment folders or components.

Option Explicit
Sub FirstPrecedents()
    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Dim i   As Long
    Dim tmp As Range
    Set Sh1 = ActiveSheet
    Set Sh2 = Worksheets.Add
    Sh2.Name = "TraceFormula"
    i = 1
    For Each tmp In Sh1.UsedRange
        On Error Resume Next
        If Left(tmp.Formula, 1) = "=" Then
            If CheckEqualRange(tmp.DirectPrecedents, tmp.Precedents) Then
                With Sh2
                    .Cells(i, 1) = tmp.Address
                    .Cells(i, 2) = "'" & tmp.Formula
                    .Cells(i, 3) = tmp.DirectPrecedents.Address
                    .Cells(i, 4) = tmp.Precedents.Address
                    .Cells(i, 5) = tmp.DirectPrecedents.Cells.Count
                    .Cells(i, 6) = tmp.Precedents.Cells.Count
                    .Cells(i, 7) = CheckEqualRange(tmp.DirectPrecedents, tmp.Precedents)
                End With
                tmp.DirectPrecedents.Interior.Color = RGB(242, 220, 219)
                i = i + 1
            End If
        End If
        On Error GoTo 0
    Next tmp
End Sub

Function CheckEqualRange(ByRef Rng1 As Range, ByRef Rng2 As Range) As Boolean
    Dim UnionRange      As Range
    Dim IntersectRange  As Range
    Dim tmp             As Range
    CheckEqualRange = False
    Set UnionRange = Application.Union(Rng1, Rng2)
    Set IntersectRange = Application.Intersect(Rng1, Rng2)
    If UnionRange.Cells.Count = IntersectRange.Cells.Count Then
        CheckEqualRange = True
    End If
End Function

I’d like to present other code with DirectDependents property and DirectPrecedents property of range object. It’s the first cell that the range has DirectDependents property but has no DirectPrecedents property.

Option Explicit
Sub FirstPrecedents2()
    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Dim i   As Long
    Dim tmp As Range
    Set Sh1 = ActiveSheet
    Set Sh2 = Worksheets.Add
    Sh2.Name = "Root"
    i = 1
    For Each tmp In Sh1.UsedRange
        On Error Resume Next
        If Left(tmp.Formula, 1) = "=" Then
            If tmp.DirectPrecedents Is Nothing And _
               Not tmp.DirectDependents Is Nothing Then
                Sh2.Cells(i, 1) = tmp.Address
                i = i + 1
            End If
        End If
        On Error GoTo 0
    Next tmp
End Sub

At last, I’d like to present the code to get the last cells that have opposite Boolean value of conditional expression.

Option Explicit
Sub LastDependents()
    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Dim i   As Long
    Dim tmp As Range
    Set Sh1 = ActiveSheet
    Set Sh2 = Worksheets.Add
    Sh2.Name = "Leaf"
    i = 1
    For Each tmp In Sh1.UsedRange
        On Error Resume Next
        If Left(tmp.Formula, 1) = "=" Then
            If tmp.DirectDependents Is Nothing And _
                Not tmp.DirectPrecedents Is Nothing Then
                tmp.Interior.Color = RGB(220, 230, 241)
                Sh2.Cells(i, 1) = tmp.Address
                i = i + 1
            End If
        End If
        On Error GoTo 0
    Next tmp
End Sub