VBA .Auto populate unique values in 2nd combobox based on 1st combobox data

0
votes

I need to populate two combo boxes from excel sheet, the data will be like below:

Column   | A Column B
----------------------
A | 1
A | 2
A | 3
A | 3
A | 5
B |10
B | 11
B | 12
A | 1 
A | 5
A | 2

So from the above data, one combo box should hold unique values A & B.

On selecting a value from the 1st combo box A or B, respective values should be populated in 2nd combo box.

So the data should be like below:

If A is selected in the 1st combo box, then 2nd combo box should only show the values 1,2,3,4 & 5. If B is selected in the 1st combo box, then 2nd combo box should only show the values 10,11 & 12.

for that i have following code : -

 Private Sub ComboBox1_Change()

 Dim rng As Range
 Set rng = Sheet2.Range("B2", Sheet2.Cells(Rows.Count, "b").End(xlUp))

 Set oDictionary = CreateObject("Scripting.Dictionary")
 Sheet1.ComboBox2.Clear

 With Sheet1.ComboBox2
For Each cel In rng
If ComboBox1.Value = cel.Offset(, -1).Value Then

        oDictionary(cel.Value) = 0
        .AddItem (cel.Value)

    End If
   Next cel
   End With
  End Sub


  Private Sub ComboBox1_DropButtonClick()

  Dim rng As Range



 Set rng = Sheet2.Range("A2", Sheet2.Cells(Rows.Count, "A").End(xlUp))

 Set oDictionary = CreateObject("Scripting.Dictionary") 'to put uniqe values     from rng variable to combo box1
  With oDictionary
  For Each cel In rng
  If Not .exists(cel.Value) Then
        .Add cel.Value, Nothing
    End If
  Next cel

Sheet1.ComboBox1.List = .keys
End With
End Sub

problem is that it combobox does not shows unique values .

how i can get unique values in combobox2 .

you can ignore my coding and provide simplest way to do above said task ...

2
vbacombobox

2 Answers

1
votes

While populating your dictionary you need to check whether the set of values for the current key already contains the current value.

I would use arrays to hold the various values from ColB for each key:

Option Explicit

Dim Dic As Object

Private Sub ComboBox1_Change()
    With ComboBox2
        .List = Dic.Item(ComboBox1.Value)
        .Value = "" '### clear any previous selection
    End With
End Sub

Private Sub ComboBox1_DropButtonClick()

    Dim rng As Range
    Dim Dn As Range, arr, v

    Set rng = Sheet2.Range("A2", Sheet2.Cells(Rows.Count, "A").End(xlUp))

    Set Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
    For Each Dn In rng

        v = Dn.Offset(0, 1)

        If Not Dic.exists(Dn.Value) Then
            Dic.Add Dn.Value, Array(v)
        Else
            arr = Dic(Dn.Value)
            'no match will return an error value: test for this
            If IsError(Application.Match(v, arr, 0)) Then
                ReDim Preserve arr(UBound(arr) + 1)
                arr(UBound(arr)) = v
                Dic(Dn.Value) = arr 'replace with expanded array
            End If
        End If

    Next

    ComboBox1.List = Dic.keys
End Sub
1
votes

enter image description here

Fill Comboboxes using a Dictionary of ArrayList

Private oDictionary As Object

Sub RefreshComboBoxes()
    Dim r As Range
    Dim list As Object
    Set oDictionary = CreateObject("Scripting.Dictionary")

    With Sheet1
        For Each r In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))

            If Not oDictionary.Exists(r.Text) Then
                Set list = CreateObject("System.Collections.ArrayList")
                oDictionary.Add r.Text, list
            End If
            If Not oDictionary(r.Text).Contains(r.Offset(0, 1).Value) Then
                oDictionary(r.Text).Add r.Offset(0, 1).Value
            End If
        Next
    End With

    ComboBox1.list = oDictionary.Keys
    ComboBox2.Clear

End Sub


Private Sub ComboBox1_Change()
    If ComboBox1.ListIndex > -1 Then
        ComboBox2.Clear
        oDictionary(ComboBox1.Text).Sort
        ComboBox2.list = oDictionary(ComboBox1.Text).ToArray
    End If
End Sub

Private Sub UserForm_Initialize()
    RefreshComboBoxes
End Sub