I'm working on a macro that takes an excel spreadsheet which contains a parent column and a child column. The macro's goal is to determine each product's depth in a BOM tree. Moreover, the spreadsheet may contain many BOM trees.

I've thought of having the root of the tree be given an initial value of 0 and then doing a check of it's children and take their parents value and adding 1. Nevertheless, I am unsure about how to go about doing it effectively because, according to my current idea, I must have certain relation-based checks and repeat them throughout the entire BOM tree.

I've managed to identify which product is a child of another product so far, but I'm having trouble figuring out how to calculate the depth.

This is what I currently have done.

```Sub findParents(startRange As String, searchValue As String, endRow As String, realtionArray() As String)
Do While True
With Worksheets("Test").range(startRange & endRow)
Set c = .Find(searchValue, LookIn:=xlValues)
Exit Do
Else ' string found
startRange = "B" & CStr(c.Row + 1)
Debug.Print c & "'s parent is " & range("A" & CStr(c.Row)).value
End If
End With
Loop
End Sub
Sub BOM()

Dim c As range
Dim searchValue As String
Dim startRange As String
Dim endRow As String
Dim searchValues() As Variant
Dim iNum As Integer
Dim varData As Variant
Dim relationArray() As String

endRow = ":B" & CStr(range("B" & Rows.Count).End(xlUp).Row + 1)
searchValues = range("D2:D" & CStr(range("D" & Rows.Count).End(xlUp).Row))

For iNum = 1 To UBound(searchValues)
startRange = "B2"
searchValue = searchValues(iNum, 1)
findParents startRange, searchValue, endRow, relationArray
Next iNum

End Sub
```

This is the test data I'm working with.

Mar 24, 2023 in Others 426 views

## 1 answer to this question.

Add on the sheet an ActiveX Microsoft Treeview Control (version 6.0) named "TreeView1" with "/" as PathSeparator (to be sure provide the separator even if it's already it) and run this macro:

```Sub SubTree()

Dim obj As Object
Dim rng As Range
Dim cell As Range
Dim str As String
Dim mynode As Node
Dim Index As Double
Dim MaxIndex As Double
Dim MinIndex As Double
Dim lvl As Double

Set rng = Range("A2:E11")

On Error Resume Next
Set obj = ActiveSheet.Shapes("TreeView1")
On Error GoTo 0

If obj Is Nothing Then
MsgBox "Create in the sheet a ActiveX Microsoft Treeview Control (version 6.0) named ""TreeView1"" with ""/"" as PathSeparator and re-run the macro", vbCritical + vbOKOnly
Exit Sub
End If

obj.OLEFormat.Object.Object.Nodes.Clear

For Each cell In rng.Columns(1).Cells
If Excel.WorksheetFunction.CountIf(rng.Columns(2), cell.Value2) = 0 Then
On Error Resume Next
On Error GoTo 0
End If
Next

MinIndex = 1

CP_Child_Nodes_Start:
MaxIndex = obj.OLEFormat.Object.Object.Nodes.Count
For Index = MinIndex To MaxIndex
Set mynode = obj.OLEFormat.Object.Object.Nodes(Index)
For Each cell In rng.Columns(1).Cells
If cell.Value2 = Split(mynode.Key, "\")(UBound(Split(mynode.Key, "\"))) Then
Debug.Print mynode.FullPath
If Len(Replace(mynode.FullPath, "\" & cell.Offset(0, 1).Value2, "")) = Len(mynode.FullPath) Then
obj.OLEFormat.Object.Object.Nodes.Add mynode, tvwChild, mynode.FullPath & "\" & cell.Offset(0, 1).Value2, cell.Offset(0, 1).Value2
Else
If Left(mynode.Text, 6) <> "#LOOP:" Then
obj.OLEFormat.Object.Object.Nodes.Add mynode, tvwChild, mynode.FullPath & "\" & cell.Offset(0, 1).Value2, "#LOOP:" & cell.Offset(0, 1).Value2
End If
End If
End If
Next
Next

If MinIndex > MaxIndex Then GoTo CP_Child_Nodes_End
MinIndex = MaxIndex + 1

GoTo CP_Child_Nodes_Start

CP_Child_Nodes_End:

For Each cell In rng.Columns(1).Cells
str = cell.Value2 & "\" & cell.Offset(0, 1).Value2
lvl = 0
For Each mynode In obj.OLEFormat.Object.Object.Nodes

If Not mynode.Parent Is Nothing Then

If Len(Replace(mynode.Key, str, "")) <> Len(mynode.Key) Then

For Index = Len(mynode.Key) To 1 Step -1

If Left(Right(mynode.Key, Index), Len(str)) = str Then
Exit For
End If

Next

lvl = Excel.WorksheetFunction.Max(lvl, UBound(Split(Left(mynode.Key, Len(mynode.Key) - Index), "\")))
Debug.Print
Debug.Print mynode.Key
Debug.Print mynode.Text
Debug.Print mynode.FullPath
If mynode.Parent Is Nothing Then
Debug.Print "."
Else
Debug.Print mynode.Root
End If
Debug.Print str, lvl
End If
End If
Next

cell.Offset(0, 4).Value2 = lvl
lvl = 0
Next
End Sub```
• 38,010 points

## Creating a function in excel VBA to calculate the average point in a circular set of numbers

I used the following code to determine ...READ MORE

## How to automatically get a specified range of data from Excel to XML in VBA

Range method works, always identify the sheet ...READ MORE

## How to programmatically get the values of a spilled Excel range in VBA?

By using the Text property, I was ...READ MORE

## Excel-VBA - How to identify Target range (more than 1 cell) is deleted in a Worksheet_Change function?

You misunderstand the purpose of the function ...READ MORE

## Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

## How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

## Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

## Excel VBA- How to loop through specific sheets in a workbook and format the same ranges in each sheet

Range(...) instructs VBA to always use the ...READ MORE

## Is there a function in excel to automatically calculate age using date of birth?

Try  =INT((YEARFRAC(TODAY(),B3,1)))  Where cell B3 contains a date like ...READ MORE