Recursive sub to determinate level of items in BOM

Question

In the next sample structure BOM:

updated screenshot

we find articles, and further down we find their structure with its content, other articles which in their turn may or may not have their content and so on.

I'm trying to create a recursive routine to determine whether or not they exist further down and determine their level:

Public eof As Long

Sub RecursiveSearch()
    Dim i As Long
    Dim ws As Worksheet
    Dim art_to_search As String
    Dim str_art As Integer
    Dim l As Integer ' Declare l as a local variable
    
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' Replace "Sheet1" with the actual sheet name
    eof = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row 'Recalc end of file
    'l is the level
    l = 1
    i = 1
    ' Loop through each row in the data range
    For i = i To eof

    art_to_search = Cells(i, 2).Value
    str_art = Len(art_to_search)

    If str_art = 15 Then
        Debug.Print i & " " & art_to_search
        Call ArticleExists(art_to_search, i + 1, eof, l)
        End If
    Next i
End Sub

Sub ArticleExists(ByVal article As String, ByVal startRow As Long, ByVal lastRow As Long, ByRef l As Integer)
    Dim a As Long
    ' Loop through each row below the start row
    For a = startRow To lastRow
        If Trim(article) = Trim(Range("A" & a).Value) Then
            l = l + 1
            Range("D" & a) = l
            Call ArticleExists(Cells(a, 2).Offset(2, 0), a + 2, lastRow, l)
            Exit Sub
        End If
    Next a
End Sub

It works, but the counting of levels is not correct. Could you give me some help to improve my understanding of recursion on this problem?

Answer 1

You can use this code.

It retrieves per Article from column A the subset of articles by using CurrentRegion - and then iterates over each sub-article the same way.

Option Explicit

Public Sub readHierarchy()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(1) '---> adjust this
readLevel ws.UsedRange.Rows(1), 1
End Sub

Private Function readLevel(rgRow As Range, iLevel As Long)
    rgRow.Cells(1, 4) = iLevel
    
    Dim rgSubLevels As Range
    Set rgSubLevels = rgRow.CurrentRegion.Offset(2)
    If rgSubLevels.Rows.Count >= 3 Then
        Set rgSubLevels = rgSubLevels.Resize(rgSubLevels.Rows.Count - 2)
    Else
        Exit Function
    End If
    
    Dim rgNext As Range
    For Each rgRow In rgSubLevels.Rows
        Set rgNext = findArticle(rgRow, rgRow.Cells(1, 2))
        If Not rgNext Is Nothing Then
            readLevel rgNext.Rows(1), iLevel + 1
        End If
    Next

End Function

Public Function findArticle(rgStart As Range, Article As String) As Range

Dim ws As Worksheet: Set ws = rgStart.Parent

Dim rgFound As Range

Set findArticle = ws.UsedRange.Columns(1).Find(What:=Article, After:=rgStart.Cells(1, 1), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
End Function