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

Question

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 ...

Tim Williams · Answer 1 · 2016-11-30T05:53:56.293

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

thanks @tim , it works , but how if i want to show values alphabetically / ascending order . — speedyraz, Nov 30 '16 at 05:52
Then you'll need to sort the arrays before assigning them to the `List` property. Plenty of examples of sorting in VBA to be found via Google. E.g.: http://stackoverflow.com/questions/152319/vba-array-sort-function (plenty of choice there) — Tim Williams, Nov 30 '16 at 05:55

score 1 · Accepted Answer · 2016-11-30T06:30:31.873

1

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

edited Nov 30 '16 at 06:30

answered Nov 30 '16 at 06:02

thanks @ thomas , but values in second combobox should be unique . – speedyraz Nov 30 '16 at 06:09
hi Thomas , it gives "run time error 91 : - failed to compare the two elements in array" on oDictionary(ComboBox1.Text).Sort under combobox1_change . – speedyraz Nov 30 '16 at 07:07
@speedyraz you must have mixed data (Strings and Numbers) values types in column B. You could cast them all to strings but it will not sort correctly. You'll have to use another solution. – Nov 30 '16 at 07:13
@speedyraz If all the values in column B are supposed to be numeric then you can cast them using `oDictionary(r.Text).Add CDbl(r.Offset(0, 1).Value)` and it will work properly. – Nov 30 '16 at 07:20
hi @Thomas , for numeric values in combobox1 giving list index = -1 , so accordingly code not working , how to deal with it ? So that irrespective to type of list values of combobox1 , it shows corresponding values in combobox 2 . – speedyraz Dec 02 '16 at 04:18
If `ComboBox1.ListIndex > -1` then there isn't an exact match in the `ComboBox1.List` but you can change `If ComboBox1.ListIndex > -1 Then` to `If oDictionary.Exists(ComboBox1.Text). Then`. – Dec 02 '16 at 06:15
@speedyraz I just tested the code it seems to work fine. If you can link me the workbook using a service like DropBox or Google Docs then I'll debug it for you. – Dec 02 '16 at 06:20
thanks @Thomas , It worked . thanks again ..... But can you tall me , Why numeric values gives -1 as list index ?? – speedyraz Dec 02 '16 at 09:28
The listindex is the index of the selected item in a list (combobox or listbox). When a list is a 0 based array of values. They are initiated at -1 to indicate that there is no selected value. If you want to unselect all the items in a list you set it's listindex to -1. When you type a value into a combobox to matches its list that value automatically gets selected. So if a combobox has a listindex of -1 then there isn't a matching value. If a combobox.value will return the value typed into its text area or an empty string, if blank. I listbox with a listindex of -1 returns null. – Dec 02 '16 at 13:04

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

2 Answers2

Fill Comboboxes using a Dictionary of ArrayList