VBA – Put a Collection inside a Scripting Dicitonary OR Make an Updateable ComboBox

The idea of the article is to make an updateable combobox, which takes all the keys of column A and writes them to the ComboBox. Then, upon selection of the corresponding values in the combobox, it provides the corresponding values in column “G”:

How does it work?

In Worksheet tblMain we set the following events:

Private Sub cmbTeams_Click()

    Application.EnableEvents = False
    
    Dim teamDictionary As New Dictionary
    fillTeamDictionary teamDictionary
    
    tblTeam.Range("G:G").Clear
    Dim indexCell As Long
    Dim myVal As Variant
    
    For Each myVal In teamDictionary(cmbTeams.Value)
        indexCell = indexCell + 1
        tblTeam.Cells(indexCell, "G") = myVal
    Next myVal
    
    Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Application.EnableEvents = False
    
    If Target.Column <= 2 Then
        Dim teamDictionary As New Dictionary
        fillTeamDictionary teamDictionary
        AddValuesToCmbTeams teamDictionary
    End If
        
    Application.EnableEvents = True

End Sub

The idea of the events is to generate 2 things only:

• • The Worksheet_Change event updates the values of the Combo Control;
  • The cmbTeams_Click event updates the values in column G;

The  modMain has the following code:

Public Function fillTeamDictionary(ByRef teamDictionary As Dictionary)
    
    Dim myCell As Range
    Dim lastRowPosition As Long
    
    lastRowPosition = LastRow(tblTeam.Name, 1)
    Dim teamRange As Range
    
    With tblTeam
        Set teamRange = .Range(.Cells(1, 1), .Cells(lastRowPosition, 1))
    End With
    
    Dim myKey As String
    Dim myVal As String
    
    For Each myCell In teamRange
        myKey = myCell
        myVal = myCell.Offset(ColumnOffset:=1)
        
        If teamDictionary.Exists(myKey) Then
            teamDictionary(myKey).Add (myVal)
        Else
            Dim newList As Collection
            Set newList = New Collection
            newList.Add (myVal)
            teamDictionary.Add myKey, newList
        End If
    Next myCell
        
End Function

Public Sub AddValuesToCmbTeams(teamDictionary As Dictionary)

    With tblTeam
        Dim myKey As Variant
        .cmbTeams.Clear
        For Each myKey In teamDictionary.Keys
            .cmbTeams.AddItem myKey
        Next myKey
    End With

End Sub


Public Function LastRow(wsName As String, Optional columnToCheck As Long = 1) As Long

    Dim ws As Worksheet
    Set ws = Worksheets(wsName)
    LastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row

End Function

Thus, in the fillTeamDictionary there is a way to put a collection to the Dictionary with the following code:

If teamDictionary.Exists(myKey) Then
    teamDictionary(myKey).Add (myVal)
Else
    Dim newList As Collection
    Set newList = New Collection
    newList.Add (myVal)
    teamDictionary.Add myKey, newList
End If

That’s all folks!