dependent dictionaries excel vba

Question

I’d like to know which is the quickest way to get the unique values from a column and then the unique values in another column for each of the values previously found in the first column

Example

Column A    Column B

Case 1      Item A
Case 1      Item B
Case 1      Item A
Case 2      Item C
Case 2      Item C
Case 3      Item D
Case 3      Item E
Case 3      Item F
Case 3      Item D

The result should return three values from the first column (Case 1, Case 2, Case 3) and then two values for Case 1 (Item A and Item B), one value for Case 2 (Item C), three values for Case 3 (Item D, Item E, Item F)

I do not want to use an advance filter or copy filtered rows in another sheet.

I tried to reach that using scripting dictionary, but I don’t know dictionary so well, and I was not able to use the keys of the first dictionary (Case 1, …) as parameters to add the items in the second dictionary (Item A, ….)

Ideally, at the end, the macro will create one textbox for each key of the first dictionary and then for each of those creates other text boxes for each key of the second dictionary (I kind of treeview but using textboxes)

Clearly, there will be a loop

Here one of the many tentatives (but, as I said, I have really poor knowledge in dictionary)

Dim d As Variant, dict As Object
Dim v As Long, a As Variant
Dim vCount As Long
Dim vCount1 As Long

Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare  'default is vbbinarycompare

 With Sheets("Sheet1") '<- alter to suite
a = .Range("a2", Range("a" & Rows.Count).End(xlUp)).Value
' change "a1"/ "a" to appropreate column reference

    'build dictionary
    For v = LBound(a, 1) To UBound(a, 1)
        'overwrite method - faster (no error control)
        'writes name&position as key, ID as item
        'dict.Itema(v, 1)(Join(Array(vVALs(v, 2)
        dict.Item(Join(Array(a(v, 1)), ChrW(8203))) = a(v, 2)
    Next v

Me.ComboBox1.List = dict.Keys
Me.ComboBox2.List = dict.Values
    'loop through the second table
    For v = 2 To .Cells(Rows.Count, 2).End(xlUp).row
        d = (Join(Array(a(v, 1))))
        If dict.Exists(d) Then
            vCount = dict.Item(d)
            MsgBox vCount
            End If
    Next v
End With

What if there is a third column ? Example

Column A    Column B    Column C

Case 1      Item A      
Case 1      Item B      number 1
Case 1      Item A      number 1
Case 2      Item C      number 2
Case 2      Item C      number 1
Case 3      Item D      number 3
Case 3      Item E      number 1
Case 3      Item F      number 1
Case 3      Item D      number 2

the result should be

Case 1
     Item A   number1
     Item B   number1
Case 2
     Item C   number1
              number2
Case 3
     Item D   number2
              number3
     Item E   number1
     Item F   number1

here the code I tried to build based on Zev Spitz suggestion, but without success

Dim row As Variant
Dim dict As New Dictionary
For Each row In Sheets("Positioning").Range("h2", Range("p" & 
Rows.Count).End(xlUp)).Rows
Dim caseKey As String
caseKey = row.Cells.Item(2, 1).Value

Dim innerDict As Scripting.Dictionary

If dict.Exists(caseKey) Then
    Set innerDict = dict(caseKey)

Else
    Set innerDict = New Scripting.Dictionary
    Set dict(caseKey) = innerDict

End If


innerDict(row.Cells.Item(2, 3).Value) = 1

Dim outerKey As Variant, innerKey As Variant, inner2Key As Variant
 Dim inner2Dict As Scripting.Dictionary
For Each innerKey In innerDict.Keys
Set inner2Dict = New Scripting.Dictionary
If inner2Dict.Exists(inner2Dict) Then
Set innerDict(innerKey) = inner2Dict

Else
Set inner2Dict = inner2Dict
End If
inner2Dict(row.Cells.Item(2, 8).Value) = 1
Next

Next


For Each outerKey In dict.Keys
Debug.Print outerKey
    For Each innerKey In innerDict.Keys
    Debug.Print vbTab, innerKey
          For Each inner2Key In inner2Dict.Keys
      Debug.Print vbTab, vbTab, inner2Key
      Next
 Next
Next

Answer 1

Loading the data using nested dictionaries

You can use a dictionary which has other dictionaries as its' values:

Dim row As Variant
Dim dict As New Dictionary
For Each row In Worksheets("Sheet1").Range("A1", "B9").Rows
    Dim caseKey As String
    caseKey = row.Cells(1, 1).Value

    Dim innerDict As Scripting.Dictionary
    If dict.Exists(caseKey) Then
        Set innerDict = dict(caseKey)
    Else
        Set innerDict = New Scripting.Dictionary
        Set dict(caseKey) = innerDict
    End If
    innerDict(row.Cells(1, 2).Value) = 1 'an arbitrary value
Next

Then you can iterate over each key in the outer dictionary, and iterate over each key in the inner dictionary. The following code, for example:

Dim outerKey As Variant, innerKey As Variant
For Each outerKey In dict.Keys
    Debug.Print outerKey
    For Each innerKey In dict(outerKey).Keys
        Debug.Print vbTab, innerKey
    Next
Next

will output the following:

Case 1
    Item A
    Item B
Case 2
    Item C
Case 3
    Item D
    Item E
    Item F

For an description of how to use a dictionary to get a unique set of values, see here.

---

Populating another combobox based on the selection in the first combobox

Assuming you've set the List property of the first combobox to the Keys collection of the dictionary:

Me.ComboBox1.List = dict.Keys

you can handle the Change event of the combobox, and use it to fill the second combobox with the keys of the corresponding inner dictionary:

Private Sub ComboBox1_Change()
    If Value Is Nothing Then
        Me.ComboBox2.List = Nothing
        Exit Sub
    End If
    Me.ComboBox2.Value = Nothing
    Me.ComboBox2.List = dict(Me.ComboBox1.Value).Keys
End Sub

---

Unique values using SQL

Another way to get the unique combinations of values might be to execute an SQL statement on the Excel worksheet:

SELECT DISTINCT [Column A], [Column B]
FROM [Sheet1$]

but this generally comes back as an ADO or DAO flat Recordset -- with fields and rows -- while nested dictionaries preserve the hierarchical nature of this data.

---

Complete code-behind

Add a reference to the Microsoft Scripting Runtime (Tools > References...)

Option Explicit

Dim dict As New Dictionary

Private Sub ComboBox1_Change()
    If Value Is Nothing Then
        Me.ComboBox2.List = Nothing
        Exit Sub
    End If
    Me.ComboBox2.Value = Nothing
    Me.ComboBox2.List = dict(Me.ComboBox1.Value).Keys
End Sub

Private Sub UserForm_Initialize()
    For Each row In Worksheets("Sheet1").Range("A1", "B9").rows
        Dim caseKey As String
        caseKey = row.Cells(1, 1).Value

        Dim innerDict As Dictionary
        If dict.Exists(caseKey) Then
            Set innerDict = dict(caseKey)
        Else
            Set innerDict = New Dictionary
            Set dict(caseKey) = innerDict
        End If
        innerDict(row.Cells(1, 2).Value) = 1 'an arbitrary value
    Next
    Me.ComboBox1.List = dict.Keys
End Sub

---

Complete code behind for two dependent comboboxes

Notice that the repetitious code has been (mostly) refactored into two methods: FindOrNew and HandleComboboxChange.

Option Explicit

Dim dict As New Dictionary

Private Function FindOrNew(d As Dictionary, key As String) As Dictionary
    If d.Exists(key) Then
        Set FindOrNew = d(key)
    Else
        Set FindOrNew = New Dictionary
        Set d(key) = FindOrNew
    End If
End Function

Private Sub HandleComboboxChange(source As ComboBox, target As ComboBox)
    If source.Value Is Nothing Then
        Set target.list = Nothing
        Exit Sub
    End If
    Set target.Value = Nothing
End Sub

Private Sub ComboBox1_Change()
    HandleComboboxChange ComboBox1, ComboBox2
    ComboBox2.list = dict(ComboBox1.Value).Keys
End Sub

Private Sub ComboBox2_Change()
    HandleComboboxChange ComboBox2, ComboBox3
    ComboBox3.list = dict(ComboBox1.Value)(ComboBox2.Value).Keys
End Sub

Private Sub UserForm_Initialize()
    For Each row In ActiveSheet.Range("A1", "C9").rows
        Dim caseKey As String
        caseKey = row.Cells(1, 1).Value
        Dim itemKey As String
        itemKey = rows.Cells(1, 2).Value

        Dim dictLevel2 As Dictionary
        Set dictLevel2 = FindOrNew(dict, caseKey)
        Dim innerDict As Dictionary
        Set innerDict = FindOrNew(dictLevel2, itemKey)

        innerDict(row.Cells(1, 3).Value) = 1 'an arbitrary value
    Next
    ComboBox1.list = dict.Keys
End Sub