Create a dynamic list of products associated to a list of unique search keywords in VBA

Question

I have a list of products each of which has its own keywords that can be used to search for that product on the site. I want to generate a list of unique keywords and a list of products that can be found for each unique keyword.

Source example

Products    Keywords
--------    --------
Envelope1   1,envelope
Envelope2   2,envelope
Label1      label,mailing
label2      label,mailing
label3      label,mailing,address

The generated list that I want would look like...

Keywords   Products
--------   --------
1          Envelope1
2          Envelope2
envelope   Envelope1,Envelope2
label      label1,label2,label3
mailing    label1,label2,label3
address    label3

I would then loop through the keywords and fetch the products for that keyword, execute a search, and then validate that all the products were found.

I can create a collection that contains the unique list of keywords but I'm struggling on how to create the associated list of products. I think I want to use a nested collection as is described here but I'm having a hard time figuring out the details because I'm trying to add to a dynamic list.

' loop through each cell in the keywords column, ignoring the column header
For i = 2 To maxRow
    ' the keywords are comma delimited so they must be Split()
    k = Split(ActiveSheet.Cells(i, keywordColumn).Value, ",")
    For j = 0 To UBound(k)
        ' turn off error checking to trap Error 457
        On Error Resume Next
        keywords.Add Item:=k(j), Key:=k(j)
        errNumber = CLng(Err.Number)
        On Error GoTo 0

        ' trap Error 457, the key already exists in the collection
        ' then ... do something to associate the product with the keyword
        If errNumber = 457 Then
            keywords.Item(k(j)).Add productCode???
        End If
    Next j
Next i

I'm not tied to this method so if there's a better way to do this... I'm fine with that. Thanks in advance for the help.

Dmitry Pavliv · Accepted Answer · 2014-02-18T18:53:19.453

You could use Dictionary object:

Sub test()
    Dim keywordColumn As String, productColumn As String
    Dim products As String
    Dim i As Integer
    Dim myKey, p

    'after adding reference to Microsoft Scripting Runtime
    'Dim Keywords As New Dictionary

    Dim Keywords As Object
    Set Keywords = CreateObject("Scripting.Dictionary")

    keywordColumn = "B"
    productColumn = "A"

    With ActiveSheet
        maxRow = .Cells(.Rows.Count, productColumn).End(xlUp).Row
        ' loop through each cell in the keywords column, ignoring the column header
        For i = 2 To maxRow
            ' the keywords are comma delimited so they must be Split()
            k = Split(.Cells(i, keywordColumn).Value, ",")

            For Each myKey In k
                If Not Keywords.Exists(myKey) Then
                    Keywords.Add key:=myKey, Item:=New Collection
                End If

                With .Cells(i, productColumn)
                    On Error Resume Next
                    Keywords(myKey).Add Item:=.Value, key:=CStr(.Value)
                    On Error GoTo 0
                End With                                        
            Next myKey
        Next i

        '**********************************************
        'OUTPUT
        '**********************************************

        i = 2
        'iterates through each key
        For Each myKey In Keywords.Keys                
            products = ""
            'iterates through each product corresponding to myKey 
            For Each p In Keywords(myKey)
                products = products & p & ", "
            Next
            'write in cells
            .Cells(i, "D") = myKey
            If products <> "" Then .Cells(i, "E") = Left(products, Len(products) - 2)

            i = i + 1
        Next

    End With
End Sub

RESULT:

enter image description here

Note: I'd recommend you to add reference to Microsoft Scripting Runtime library (go to Tools->References and select Microsoft Scripting Runtime). In that case you could use:

Dim Keywords As New Dictionary

instead

Dim Keywords As Object
Set Keywords = CreateObject("Scripting.Dictionary")

Referencing to library makes your code faster and adds intellisence feature for your Keywords object.

Thanks for the quick answer... I'm already headed in this direction (Dictionaries) and I think your example code will help get me there... thanks! — , Feb 18 '14 at 18:41

score 0 · Answer 2 · edited Feb 21 '14 at 21:34

0

The algorithm I used for a similar project was something like this

Array1: 1D array for storing the keywords. No duplicates

Array2: 2D array. Rows equal to Array1. In each row there will be an array of products that are associated with keyword.

Step1: You would loop through all the keywords and populate Array1

Step2: You would double loop through the keywords and products and populate Array2.

edited Feb 21 '14 at 21:34

Andrew Barber

39,603
20
94
123

answered Feb 18 '14 at 18:08

Math4123

1,267
4
12
23

1

I was toying with something like this but I wanted to avoid having to use two arrays. Thanks for the answer though... – Feb 18 '14 at 18:42
Np, let me know if you have any more questions – Math4123 Feb 18 '14 at 19:06

Create a dynamic list of products associated to a list of unique search keywords in VBA

2 Answers2