Sub MakeTheList()
    
    Dim dic As Object
    Dim dic2 As Object
    Dim Contents As Variant
    Dim ParentKeys As Variant
    Dim ChildKeys As Variant
    Dim r As Long, r2 As Long
    Dim LastR As Long
    Dim WriteStr As String
    
    ' Create "parent" Dictionary.  Each key in the parent Dictionary will be a disntict
    ' Code value, and each item will be a "child" dictionary.  For these "children"
    ' Dictionaries, each key will be a distinct Product value, and each item will be the
    ' sum of the Quantity column for that Code - Product combination
    
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    
    ' Dump contents of worksheet into array
    
    With ThisWorkbook.Worksheets("Data")
        LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
        Contents = .Range("a2:c" & LastR).Value
    End With
        
    ' Loop through the array
    
    For r = 1 To UBound(Contents, 1)
        
        ' If the current code matches a key in the parent Dictionary, then set dic2 equal
        ' to the "child" Dictionary for that key
        
        If dic.Exists(Contents(r, 1)) Then
            Set dic2 = dic.Item(Contents(r, 1))
            
            ' If the current Product matches a key in the child Dictionary, then set the
            ' item for that key to the value of the item now plus the value of the current
            ' Quantity
            
            If dic2.Exists(Contents(r, 2)) Then
                dic2.Item(Contents(r, 2)) = dic2.Item(Contents(r, 2)) + Contents(r, 3)
            
            ' If the current Product does not match a key in the child Dictionary, then set
            ' add the key, with item being the amount of the current Quantity
            
            Else
                dic2.Add Contents(r, 2), Contents(r, 3)
            End If
        
        ' If the current code does not match a key in the parent Dictionary, then instantiate
        ' dic2 as a new Dictionary, and add an item (Quantity) using the current Product as
        ' the Key.  Then, add that child Dictionary as an item in the parent Dictionary, using
        ' the current Code as the key
        
        Else
            Set dic2 = CreateObject("Scripting.Dictionary")
            dic2.CompareMode = vbTextCompare
            dic2.Add Contents(r, 2), Contents(r, 3)
            dic.Add Contents(r, 1), dic2
        End If
    Next
    
    ' Add a new worksheet for the results
    
    Worksheets.Add
    [a1:b1].Value = Array("Code", "Product - Qty")
    
    ' Dump the keys of the parent Dictionary in an array
    
    ParentKeys = dic.Keys
    
    ' Write the parent Dictionary's keys (i.e., the distinct Code values) to the worksheet
    
    [a2].Resize(UBound(ParentKeys) + 1, 1).Value = Application.Transpose(ParentKeys)
    
    ' Loop through the parent keys and retrieve each child Dictionary in turn
    
    For r = 0 To UBound(ParentKeys)
        Set dic2 = dic.Item(ParentKeys(r))
        
        ' Dump keys of child Dictionary into array and initialize WriteStr variable (which will
        ' hold concatenated products and summed Quantities
        
        ChildKeys = dic2.Keys
        WriteStr = ""
        
        ' Loop through child keys and retrieve summed Quantity value for that key.  Build both
        ' of these into the WriteStr variable.  Recall that Excel uses linefeed (ANSI 10) for
        ' in-cell line breaks
        
        For r2 = 0 To dic2.Count - 1
            WriteStr = WriteStr & Chr(10) & ChildKeys(r2) & " - " & dic2.Item(ChildKeys(r2))
        Next
        
        ' Trim leading linefeed
        
        WriteStr = Mid(WriteStr, 2)
        
        ' Write concatenated list to worksheet
        
        Cells(r + 2, 2) = WriteStr
    Next
    
    ' Sort and format return values
    
    [a1].Sort Key1:=[a1], Order1:=xlAscending, Header:=xlYes
    With [b:b]
        .ColumnWidth = 40
        .WrapText = True
    End With
    Columns.AutoFit
    Rows.AutoFit
    
    ' Destroy object variables
    
    Set dic2 = Nothing
    Set dic = Nothing
    
    MsgBox "Done"
    
End Sub

Select all