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
