Recursively search a table in VBA

user_1946906 0
Viewed 56

I have a BOM that I can get a structured look like this, where it pulls for all my products.

enter image description here

I'm trying to pull all members of a particular BOM recursively through VBA. so far I can get the top level items, but I cannot get anything beyond that. Can someone point me in the right direction with my code on what I need to do next? IF something better than recursion could work here I could do that as well, it was just my initial thought.

'getMembers gets all items of the member field
    Function getMembers(member As String) As Variant
        'declare range of BOM
        Dim rng As range
        Set rng = Worksheets("Allboms").range("All_Boms[name]")
        
        Dim i As Integer
        i = 0
        Dim members() As String
        ReDim members(1)
        
        For Each cell In rng
            If cell.Value = member Then
                members(i) = cell.Offset(, 4).Value
                i = i + 1
                ReDim Preserve members(i)
            End If
        Next
        getMembers = members
    End Function

Sub getMemberItems()
    'declare where product is
    Dim product As String
    product = range("C3").Value
    Dim item As Variant
   
    For Each item In getMembers(product)
        Debug.print item
    Next item
        
End Sub
vba excel
1 Answers

Non-recursive approach using a Collection as a queue:

Sub Tester()
    Dim m
    For Each m In getMembers("A")
        Debug.Print m
    Next m
End Sub


'getMembers gets all items of the member field
Function getMembers(member As String) As Collection
    Dim rng As Range, c As Range
    Dim rv As New Collection, q As New Collection, m, v
    
    Set rng = Worksheets("Allboms").Range("All_Boms[name]")
    q.Add member 'start the queue
    
    Do While q.Count > 0
        m = q(1)
        q.Remove 1
        For Each c In rng.Cells
            If c.Value = m Then
                v = c.Offset(, 4).Value
                If Not IsError(Application.Match(v, rng, 0)) Then
                    q.Add v  'has sub-members: add to queue
                Else
                    rv.Add v 'no sub-members: add to output
                End If
            End If
        Next
    Loop
    Set getMembers = rv
End Function
user_4788840
Related