Common Table Expression coded in Excel macro

[ArchieDavid]

Hi,

I have this data in excel sheet1:

Component Name Partname
BMW Car Engine
BMW Car Body
BMW Car Wheels
Cesna APlane Rotor
Rotor Spinner Blade
Engine CarPart Piston
Piston SmlPart SparkPlug

I would like to create a macro and would output this on sheet2

If Key used is BMW the output would be:

Level Component Name Partname
1 BMW Car Engine
1 BMW Car Body
1 BMW Car Wheels
2 Engine CarPart Piston
3 Piston SmlPart Spark Plug

if key used is Cesna, output on sheet2 should be:
Level Component Name Partname
1 Cesna APlane Rotor
2 Rotor Spinner Blade

Thanks in advance.

Archie

 

[circledchicken]

Hi,

Assuming your data isn't too big, perhaps try a recursive function, something like this (this assumes the data starts in A2 with column headers in row 1 of Sheet1):

Option Explicit


Private vArr    As Variant
Private vOut    As Variant


Sub example()


    Dim j   As Long
    
    ' retrieve base table
    vArr = Sheet1.Range("A1").CurrentRegion
    
    ' create output array (increase 50000 if
    ' more rows expected)
    ReDim vOut(1 To 50000, 1 To 3)
    get_children "BMW", j
    
    ' print result to worksheet
    With Sheet2
        .Range("A1").Resize(1, 3) = Array("Component", "Name", "Partname")
        .Range("A2").Resize(UBound(vOut, 1), _
                            UBound(vOut, 2)) = vOut
    End With
        
End Sub


Private Function get_children( _
           ByVal vParent As Variant, _
           ByRef j As Long)
    
    Dim dict    As Object
    Dim i       As Long
    Dim v       As Variant
    
    ' retrieve all children of parent
    Set dict = CreateObject("scripting.dictionary")
    With dict
        ' start from 2 (ignoring header row)
        For i = 2 To UBound(vArr, 1)
            If vArr(i, 1) = vParent Then
                .Add Key:=i, _
                     Item:=Array(vArr(i, 1), _
                                 vArr(i, 2), _
                                 vArr(i, 3))
            End If
        Next i
    End With


    ' write to output array
    For Each v In dict
        j = j + 1
        vOut(j, 1) = dict.Item(v)(0)
        vOut(j, 2) = dict.Item(v)(1)
        vOut(j, 3) = dict.Item(v)(2)
        ' recurse
        get_children dict.Item(v)(2), j
    Next v


End Function

 

[ArchieDavid]

Thanks Circledchicken... I'll try the code by I do have some questions..

1. At the vOut part of sub example should it not be up to vOut, 3 since there are 3 columns?
2. Also can we add Level column to indicate identify the parent child relationship level?
3. Lastly, kindly add more explanation on the loop part of function get children? I am reading it but my brain does not understand it. I really want to learn but my brain is not coping up with the complexity of the code. I could not even decipher which part lists all the parent record and which part list level 2 child record and level 3 child record.

Thanks for the help.

Best regards,
Archie David

 

[mikerickson]

Perhaps something like this

Sub test()
    Dim startTerm As String
    Dim rowsShown As Long
    Dim filterArray As Variant, filterSize As Long
    Dim i As Long
    
    startTerm = Application.InputBox("Enter key term", Default:="BMW", Type:=2)
    If startTerm = "False" Then Exit Sub: Rem cancel pressed
    
    filterArray = Array(startTerm)
    
    With Sheet1.Range("A1").CurrentRegion: Rem adjust
        
        Do
            filterSize = UBound(filterArray)
            .AutoFilter Field:=1, Criteria1:=filterArray, Operator:=xlFilterValues
            
            For i = 2 To .Rows.Count
                With .Cells(i, 3)
                    If Not .EntireRow.Hidden Then
                        If IsError(Application.Match(.Value, filterArray, 0)) Then
                            ReDim Preserve filterArray(0 To UBound(filterArray) + 1)
                            filterArray(UBound(filterArray)) = .Value
                        End If
                    End If
                End With
            Next i
            
        Loop Until filterSize = UBound(filterArray)
        
    End With
End Sub

 

[ArchieDavid]

Hi MikErickson,

Thanks.. the filtering loop worked like a charm.. d

however, I tried to incorporate and add Level column I could not make it work. Any help would be greatly appreciated.

Cheers!
Archie David

 

[circledchicken]

Thanks Circledchicken... I'll try the code by I do have some questions..

1. At the vOut part of sub example should it not be up to vOut, 3 since there are 3 columns?
2. Also can we add Level column to indicate identify the parent child relationship level?
3. Lastly, kindly add more explanation on the loop part of function get children? I am reading it but my brain does not understand it. I really want to learn but my brain is not coping up with the complexity of the code. I could not even decipher which part lists all the parent record and which part list level 2 child record and level 3 child record.

Thanks for the help.

Best regards,
Archie David

Hi Archie,

In answer to some of your questions:

1. UBound(vOut, 2) returns three in the previous example - i.e. the upper bound of the second dimension (i.e. number of columns) in the array.
2. You can try the example below that includes a level column:

Option Explicit


Private vArr    As Variant
Private vOut    As Variant


Sub example()


    Dim j   As Long
    
    ' retrieve base table
    vArr = Sheet1.Range("A1").CurrentRegion
    
    ' create output array (increase 50000 if
    ' more rows expected)
    ReDim vOut(1 To 50000, 1 To 4)
    get_children "BMW", j, 0
    
    ' print result to worksheet
    With Sheet2
        .Range("A1").Resize(1, 4) = Array("Component", "Name", _
                                          "Partname", "Level")
        .Range("A2").Resize(UBound(vOut, 1), _
                            UBound(vOut, 2)) = vOut
    End With
        
End Sub


Private Function get_children( _
           ByVal vParent As Variant, _
           ByRef j As Long, _
           ByVal lngLevel As Long)
    
    Dim dict        As Object
    Dim i           As Long
    Dim v           As Variant
    
    ' retrieve all children of parent
    Set dict = CreateObject("scripting.dictionary")
    With dict
        ' start from 2 (ignoring header row)
        For i = 2 To UBound(vArr, 1)
            If vArr(i, 1) = vParent Then
                .Add Key:=i, _
                     Item:=Array(vArr(i, 1), _
                                 vArr(i, 2), _
                                 vArr(i, 3))
            End If
        Next i
    End With


    ' write to output array
    lngLevel = lngLevel + 1
    For Each v In dict
        j = j + 1
        vOut(j, 1) = dict.Item(v)(0)
        vOut(j, 2) = dict.Item(v)(1)
        vOut(j, 3) = dict.Item(v)(2)
        vOut(j, 4) = lngLevel
        ' recurse
        get_children dict.Item(v)(2), j, lngLevel
    Next v


End Function

3. Perhaps a short introduction to recursive procedures might help with understanding what is happening. You can Google or here is one:
Recursion