#The story... A bit of background info and how is the database designed...

Please notice you don't really have to rebuild the tables in SQL but I shared an SQL Fiddle just in case and screenshots¹ of what the database looks like. I thought it was going to be easier to explain the story of what I am doing + you can always quickly build your own if you wanted to.

So the tables look like:

The PART table basically stores all Parts. The PARTARC is a table that stores relationships.

In this scenario a more logical explanation of what PARTARC actually represents would be:

• PART1 is a complete KIT and includes:
  • PART2 (a LEFT-HAND model)
  • PART5 (a RIGHT-HAND model)
  • PART3 (a LABEL/STICKER)
• PART2 is a left-hand model made up of 2 components
  • PART4 (a B (Buy) type component)
  • PART6 (a B (Buy) type component)
• PART3 is just a sticker/label. The M type means it's made at the factory.
• PART4 is a low-level component of B type.
• PART5 is what PART2 really is but the RIGHT-HAND model, made up of
  • PART4 (a B (Buy) type component)
  • PART6 (a B (Buy) type component)
• PART6 is a low-level component of B type.

The point here is that PART1 is the top-level assembly part and it's made up of other components like for example PART2 or PART5 which are of type M which means they can also be made and sold separately as top-level assemblies. The B means that the part is not sold separately and can't be a top level assembly - this is why you shouldn't (will not) find the B type parts in column A on spreadsheet.

Hope this is now all clear.

#The goal... To build an object oriented data structure off of the tables and populate the spreadsheet in a very specific way.

The goal is to print out all Parent parts followed by their Children relationship to spreadsheet in a very specific format shown below. (click the image for full resolution):

Note: the prices may seem illogical as PART1 is made up of other more expensive parts but it's final price is quite low. Please ignore that fact, it's completely irrelevant in the scenario. The Price column's purpose is only to have an extra property on the PART class.

#Current solution

I have created my own COM library to hide the connection string details form the end user. Basically, it comes down to attaching references to my .tlb, creating an instance of the COM class and returning an active ADODB.Connection to by calling cnWrapper.GetConnection.

VBA Project structure:

Module1 - Engine

Option Explicit

Private cn As ADODB.Connection ' global due to being passed around

Sub Main()
    
    Dim cnWrapper As ConnectionExt      ' COM
    Set cnWrapper = New ConnectionExt   ' COM
    Set cn = cnWrapper.GetConnection    ' Gets an active ADODB.Connection
    
    ' if sucessfully connected then
    If (cn.State And adStateOpen) = adStateOpen Then
    
        Dim c As Parts
        Set c = New Parts
    
        BuildTheCollection c
        
        If Not IsEmpty([A1]) Then Cells.Delete ' clear spreadsheet
        
        PrintTheCollection c, 1 ' being called resursively
        
        AddAndFormatHeaders ' can't be called from PrintTheCollection due to recursitivity
    
    End If
    
    If Not (cn Is Nothing) Then
        If (cn.State And adStateOpen) = adStateOpen Then
            cn.Close
            Set cn = Nothing
        End If
        Set cnWrapper = Nothing
    End If

End Sub





Private Sub BuildTheCollection(c As Parts)
    
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    
    On Error GoTo AllPartsHandler
    
        ' grab all the M type parts
        rs.Open Queries.AllParts, cn, adOpenStatic, adLockOptimistic
        
        ' iterate the recordset and build the OO structure
        While Not rs.EOF
    
            ' returns and adds to Parts collection a new Part instance based on the PartId
            c.Add CreatePart(rs(0))
            
            rs.MoveNext
        Wend
    
AllPartsHandler:
    Debug.Print IIf(Len(Err.Description) > 0, "All Parts Query Handler says: " & Err.Description, vbNullString)
    If Not (rs Is Nothing) Then
        If (rs.State And adStateOpen) = adStateOpen Then
            rs.Close
            Set rs = Nothing
        End If
    End If
    Exit Sub
End Sub





Function CreatePart(Id As Long, Optional theParent As Part) As Part
    
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
            
    On Error GoTo SinglePartHandler
        
        rs.Open Queries.FromPartId(Id), cn, adOpenStatic, adLockOptimistic
        
        Dim p As Part
        Set p = New Part
        
        If Not theParent Is Nothing Then
            Set p.Parent = theParent
        Else
            Set p.Parent = p
            p.IsRoot = True
        End If
        
        p.Id = rs(0)
        p.T = rs(1)
        p.Name = rs(2)
        p.Price = rs(3)
        
        Set p.Children = GetChildren(p)
        
        If Not (rs Is Nothing) Then
            If (rs.State And adStateOpen) = adStateOpen Then
                rs.Close
                Set rs = Nothing
            End If
        End If
                        
        Set CreatePart = p

        Exit Function
    
SinglePartHandler:
    Debug.Print IIf(Len(Err.Description) > 0, "Single Part Query Handler says: " & Err.Description, vbNullString)
    If Not (rs Is Nothing) Then
        If (rs.State And adStateOpen) = adStateOpen Then
            rs.Close
            Set rs = Nothing
        End If
    End If
End Function





Function GetChildren(ByRef p As Part) As Parts
    
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset

    On Error GoTo ChildrenHandler
    rs.Open Queries.Sons(p.Id), cn, adOpenStatic, adLockOptimistic
    
    Dim c As Parts
    Set c = New Parts

    On Error GoTo ChildrenHandler

        ' if has children , check and then add them
        If rs.RecordCount > 0 Then
            While Not rs.EOF
                Dim newPart As Part
                Set newPart = CreatePart(rs(0), p)
                c.Add newPart
                rs.MoveNext
            Wend
        End If
        
        If Not (rs Is Nothing) Then
            If (rs.State And adStateOpen) = adStateOpen Then
                rs.Close
                Set rs = Nothing
            End If
        End If
    
        Set GetChildren = c
    
        Exit Function
    
ChildrenHandler:
    Debug.Print IIf(Len(Err.Description) > 0, "Children Query Handler says: " & Err.Description, vbNullString)
    If Not (rs Is Nothing) Then
        If (rs.State And adStateOpen) = adStateOpen Then
            rs.Close
            Set rs = Nothing
        End If
    End If
End Function

Module2 - Printer

Option Explicit

Sub PrintTheCollection(c As Parts, Optional depth As Long)
Application.ScreenUpdating = False
    
    Dim p As Part
    For Each p In c
        
        If p.IsRoot Then
    
            Dim row As Long
            row = Range("A" & Rows.Count).End(xlUp).row + 1
            Range("A" & row) = p.Name
            Range("B" & row) = p.T
            Range("C" & row) = p.Price
            
            If p.Children.Count > 0 Then
                PrintTheCollection p.Children
            End If
        
        Else
            
            row = Range("A" & Rows.Count).End(xlUp).row
            
            Dim column As Long
            column = Cells(row, Columns.Count).End(xlToLeft).column + 1
            
            Cells(row, column) = p.Name
            Cells(row, column + 1) = p.T
            Cells(row, column + 2) = p.Price
            Cells(row, column + 3) = p.Parent.Name
            
            If p.Children.Count > 0 Then
                PrintTheCollection p.Children
            End If
            
        End If
    Next
        
Application.ScreenUpdating = True
End Sub

Sub AddAndFormatHeaders(Optional trigger As Boolean)
Application.ScreenUpdating = False

    'add headers
    [A1] = "PART NAME"
    [b1] = "TYPE"
    [c1] = "PRICE"

    [d1] = [A1]
    [e1] = [b1]
    [f1] = [c1]
    [g1] = "PARENT"

    Dim i As Long, j As Long
    ' the cells are deleted and there will be no user input on the sheet
    ' so usedRange.Columns.Count will always be fine here
    For i = 8 To ActiveSheet.UsedRange.Columns.Count Step 4
        For j = 0 To 3
            Cells(1, i + j) = Cells(1, j + 4)
        Next
    Next
    
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With

    ActiveWindow.FreezePanes = True
    
    Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Part class

Public Id As Long
Public IsRoot As Boolean
Public Name As String
Public T As String ' * 1 <- yeah, I wish there was a Char type
Public Price As Double

Public Parent As Part
Public Children As Parts

Private Sub Class_Initialize()
    Set Children = New Parts
End Sub

Private Sub Class_Terminate()
    Set Children = Nothing
End Sub

Parts Collection Class (any TextEditor -> save to .cls -> import file into VBA Project

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Parts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private c As Collection

Private Sub Class_Initialize()
    Set c = New Collection
End Sub

Private Sub Class_Terminate()
    Set c = Nothing
End Sub

Public Sub Add(ByVal ItemToAdd As Part
     c.Add ItemToAdd
 End Sub

Public Property Get Item(index As Long) As Part
Attribute Item.VB_UserMemId = 0
    Set Item = c.Item(index)
End Property

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
     Set NewEnum = c.[_NewEnum]
End Property

Public Property Get Count() As Long
    Count = c.Count
End Property

Queries static class -> Txt Editor -> save .cls -> import file VBA

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Queries"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Option Explicit

Public Function AllParts() As String
    AllParts = "SELECT  PART.PartId as 'PART ID' , " & _
               "        PART.Type as 'TYPE' , " & _
               "        PART.Name as 'PART NAME', " & _
               "        PART.Price as 'PRICE' " & _
               "FROM " & _
               "        PART " & _
               "WHERE " & _
               "        PART.Type = 'M' "
End Function

Public Function FromPartId(Id As Long) As String
    FromPartId = "SELECT  PART.PartId as 'PART ID' , " & _
                 "        PART.Type as 'TYPE' , " & _
                 "        PART.Name as 'PART NAME', " & _
                 "        PART.Price as 'PRICE' " & _
                 "FROM " & _
                 "        PART " & _
                 "WHERE " & _
                 "        PART.PartId = " & Id & " "
End Function

Public Function Sons(Id As Long)
    Sons = "SELECT  PARTARC.Son " & _
           "FROM " & _
           "        PARTARC " & _
           "            left join PART on PART.PartId = PARTARC.Son " & _
           "WHERE " & _
           "         PARTARC.Part = " & Id
End Function

#Concerns:

• Is the CreatePart() function in Module1 a sign of bad encapsulation? Shouldn't it be a part of Part class? I was debating that for a long time but ended up doing it the way shown above. If I wanted to make this a member of Part class I would have to make Part static or have a spare, free-floating instance of Part hanging around - and I didn't want to do that. If you can think of a better approach I would love to hear about it.

• Error handling... I not sure I am doing it correctly. I have been encountering tons of errors before I tied everything up and have had at least 10 different ways to handle different errors. Once I started getting rid of some of the errors and I knew the exact reason an error occurred I assumed (rather safely) that some of them will not happen again I removed extra handlers.

• Tested the code in a real life situation with 2K parts in the PART table and over 30K in the PARTARC. In my case the code built up the collection in about the same time it was printing it to the spreadsheet (30 seconds & 30 seconds) - therefore if there is anything I have missed or could be improved to speed things up a bit I would really appreciate your advices.

• Speed, efficiency, general approach etc.. Any tips, improvements are very welcome.

One thing though - please pretend my variable named c has a proper, more suitable name. That c for Collection is like i in a for loop for me ;)