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:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
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:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
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:
|
1 2 3 4 5 6 7 8 |
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!