Populate listbox based on combobox selection

[IntelligentCan1517]

Hi, Im quite new to VBA thanks in advance if anyone can help with this.



I have two columns data: option and description as per the attached link. (Capture1111)

on the user form I have a combo box and listbox. I populated combo box with unique option column values in my case I get Angora, Baft and Denim. Id like to display all the description column values when certain option is chosen on combobox. So for example if 'Baft' option were chosen I would get two description values listed in a list box (2A type-cotton cloth and 13A type-cotton cloth). How I can set to populate a listbox? (ps description column never has duplicate values they are all different)

 

[Colo]

Hi,
Since you said that you are new to VBA, I'll explain step by step.
Assuming you have Userform1.
Userform1 has a ComboBox control named ComboBox1.
Userform1 has a Listbox control named ListBox1.
Data attached as Capture1111 is placed on a range A1 to B9 in a worksheet named Sheet1.

The following procedures have to be placed in UserForm1 module.


'Declare this variable here so that it can be used from procedures in UserForm1 module.

Dim rngData As Range

Private Sub UserForm_Initialize()
'This Event runs when Userform1 is initialized
'Change here to suit your data
    Set rngData = Sheets("Sheet1").Range("A2:B9")

    'Set unique Option list to ComboBox1
    Me.ComboBox1.List = Array_Unique_Collection(rngData.Columns(1).Value)
End Sub

Private Sub ComboBox1_Change()
'This Event runs when ComboBox1 is changed
    Me.ListBox1.Clear

    For i = 1 To rngData.Rows.Count
        If rngData.Cells(i, 1).Value = ComboBox1.Value Then
            Me.ListBox1.AddItem rngData.Cells(i, 2).Value
        End If
    Next
End Sub

Function Array_Unique_Collection(ByVal NotUniqueArry As Variant) As Variant
'This is a function returns unique collection as a 1D array.
'returns NULL when there is no value
    Dim cTmp As New Collection
    Dim i As Long
    Dim aTmp As Variant
    Dim vElm As Variant

    On Error Resume Next
    For Each vElm In NotUniqueArry
        cTmp.Add CStr(vElm), CStr(vElm)
    Next
    On Error GoTo 0
    If cTmp.Count = 1 And cTmp.Item(1) = vbNullString Then
        Array_Unique_Collection = Null
        Exit Function
    End If
    ReDim aTmp(1 To cTmp.Count)
    For i = 1 To cTmp.Count
        aTmp(i) = cTmp.Item(i)
    Next
    Array_Unique_Collection = aTmp
End Function