dependent dictionaries excel vba - excel

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