A VBA Product Dictionary with a Collection of Product Services I need to extract unique Product Group names along with its corresponding services from a table in a worksheet. The table is generated by a bot and is not filtered, I have sorted it by alphabetical order. The data is not fixed and can contain anywhere from 5 - 100 rows of data, depending on the month which the report from the bot is generated.
I decided to use a Dictionary to store the the Product Group Name as they Key, while using a Collection to store services. The Collection only stores unique services by using On Error Resume Next
What changes could I make to my code?
Snippet of my Table

Code
Public Sub BuildTMProductDictionary()

Dim tmData As Variant
tmData = Sheet1.ListObjects(&quot;Table1&quot;).DataBodyRange.Value

Dim i As Long
For i = LBound(tmData, 1) To UBound(tmData, 1)
    Dim product As String
    product = tmData(i, 1)
    
    'store unique services in a collection, On Error Resume Next used to avoid duplicates
    On Error Resume Next
    Dim services As New Collection
    services.Add (tmData(i, 2)), (tmData(i, 2))
    
    'get the product name of the next row
    Dim nextProduct As String
    nextProduct = tmData(i + 1, 2)
    
    'compare the current product against the next product create New Dictionary if &lt;&gt;
    If product &lt;&gt; nextProduct Then
        Dim productGroup As New Dictionary
        productGroup.Add product, services
        Set services = New Collection
    End If
Next
End Sub

Edit
My Collection of services needs to be unique. As an example &quot;Positive Pay&quot; which belong to the &quot;ARP&quot; product group should only appear once in the collection.
You seem to be misunderstanding how to use a Scripting.Dictionary.
There is no need to sort the data before processing into a dictionary.
There is also no need to construct a collection before you add to the dictionary.
Its also slightly more sensible to write the sub as a function.
As a final tweak I'd pass the array in as a parameter rather than hardwiring it into the function, but I'll leave that as an exercise for the reader (smile)
Public Function BuildTMProductDictionary() As Scripting.Dictionary

    Dim tmData As Variant
    tmData = Sheet1.ListObjects(&quot;Table1&quot;).DataBodyRange.Value
    
    
    Dim myDict As Scripting.Dictionary
    Set myDict = New Scripting.Dictionary
    
    Dim i As Long
    For i = LBound(tmData, 1) To UBound(tmData, 1)
    
        Dim myProduct As String
        myProduct = tmData(i, 1)
        
        Dim myService As String
        myService = tmData(i, 2)
    
        If Not myDict.exists(myProduct) Then
        
            myDict.Add myProduct, New Collection
        
        End If
        
        myDict.Item(myProduct).Add myService
        
    Next
    
    Set BuildTMProductDictionary = myDict

End Function

Replace
   If Not myDict.exists(myProduct) Then

        myDict.Add myProduct, New Collection

    End If

    myDict.Item(myProduct).Add myService

with
    If Not myDict.exists(myProduct) Then
    
        myDict.Add myProduct, New Scripting.Dictionary
    
    End If
    
    If Not myDict.Item(myProduct).exists(myService) Then
    
        myDict.Item(myProduct).Add myService,myService
        
    End If