Listbox with unique and dependent items - VBA

Hi,

Sorry if this is a topic well discussed, but I have been working on this basic code to have it doing this:

I have a Listbox1 in which I was able to populate it with unique items (from columnB in Programmes worksheet) using a collection (that was a good achievement for me!)

Now, I want to populate a the Listbox2 with items (not repeated) from columnC, BUT only if the correspondent value on columnB is equal to listbox1.value.
Could you please help me finding a solution for this? I am just a beginner in VBA...

THANKS!

<script type="text/javascript">
<!--

Private Sub CommandButton2_Click()

Dim myList As Collection
Dim myVal As Variant

Set Programmes = Worksheets("Programmes")
Set ws = Worksheets("Tables")
Set myList = New Collection

'Clear listbox
ws.ListBox2.Clear

'Last used cell in the entry table
LR = Programmes.Cells(Rows.Count, 1).End(xlUp).Row


For X = 5 To LR
    Set myCell = Programmes.Cells(X, 3)
    If Programmes.Cells(X, 2) = ws.ListBox1.Value Then
         myList.Add (myCell.Value), CStr(myCell.Value) 'RUN-TIME ERROR 457 - this key is already associated with an element of this collection
    End If
       
Next X
On Error GoTo 0

For Each myVal In myList
ws.ListBox2.AddItem myVal
Next myVal

End Sub

//-->
</script>

Hi,

please edit your post and use CODE tags for your code, you'll find a link how to do that in my signature.

In order to make your code work you have to place "On Error Resume Next" above the loop where the collection is filled.

Personally I'd suggest the usage of a dictionary:

Option Explicit

Private Sub CommandButton2_Click()

    Dim myDic As Object
    Dim myVal As Variant
    Dim Programmes As Excel.Worksheet
    Dim ws As Excel.Worksheet
    
    Set Programmes = Worksheets("Programmes")
    Set ws = Worksheets("Tables")
    
    Set myDic = CreateObject("Scripting.Dictionary")
    
    'Clear listbox
    ws.ListBox2.Clear
    
    'Last used cell in the entry table
    LR = Programmes.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    For X = 5 To LR
    
        Set myCell = Programmes.Cells(X, 3)
        If Programmes.Cells(X, 2) = ws.ListBox1.Value Then
            myDic(myCell.Value) = 0
        End If
        
    Next X
    
    For Each myVal In myDic.Keys
        ws.ListBox2.AddItem myVal
    Next myVal

End Sub

Another one.

Private Sub UserForm_Initialize()
    
    Dim b As Variant, v As Variant
    
    'Column B values
    With Worksheets("Programmes")
        b = .Range("B5", .Range("B" & Rows.Count).End(xlUp)).Value
    End With
    
    'Populate Listbox1 with unique list from column B
    With CreateObject("Scripting.Dictionary")
        For Each v In b
            .Item(v) = 1
        Next v
        Me.ListBox1.List = .Keys
    End With
    
End Sub
    
    
Private Sub CommandButton2_Click()
    
    Dim bc As Variant, i As Long
    
    If Me.ListBox1.ListIndex = -1 Then Exit Sub 'Nothing selected in Listbox1
    
    'Column B:C values
    With Worksheets("Programmes")
        bc = .Range("B5", .Range("C" & Rows.Count).End(xlUp)).Value
    End With
    
    'Populate Listbox2 with unique list from column C of selected item from Listbox1
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(bc, 1)
            If bc(i, 1) = Me.ListBox1.Value Then .Item(bc(i, 2)) = 1
        Next i
        Me.ListBox2.List = .Keys
    End With
    
End Sub