VBA Populate a listbox with a selection from another listbox

[Mike_CS]

Hi All, have trawled the net with no complete answer so am once again turning to the good people of MrExcel.

I have a userform which contains 2 list boxes. ListBox1 uses the below code to cycle through a range and removes duplicates (works fine). I need listbox2 to populate itself based on the selection of listbox1.

There are 2 ranges one inside the other laid out like this:

Team1 Job1
Team1 Job2 etc.
Team2 Job1
Team2 Job2 etc
Team3 etc.

One range is just the one column (Teams Column) where I get the team names using listbox1 code.

The second range is both columns (Teams and Jobs Column) and i would like Listbox2 to populate with any entries in Column 2 that have the selected team in column 1.


Listbox1 code: Function CREATE_TEAM_LIST()
Dim v, e
With Sheets("Lists").Range("team_list")
v = .Value
End With
With CreateObject("scripting.dictionary")
.comparemode = 1
For Each e In v
If Not .exists(e) Then .Add e, Nothing
Next
If .Count Then Me.cmbReqTeam.List = Application.Transpose(.keys)
End With
End Function

Hope this made sense.

Thanks

Mike

 

[wideboydixon]

Private Sub UserForm_Initialize()

CREATE_TEAM_LIST

End Sub
Sub CREATE_TEAM_LIST()

Dim firstCell As Range
Dim thisCell As Range

Me.cmbReqTeam.Clear
Me.cmbReqJob.Clear
Set firstCell = Sheets("Lists").Range("team_list")(1)
For Each thisCell In Sheets("Lists").Range("team_list")
    If Application.WorksheetFunction.CountIf(Range(firstCell, thisCell), thisCell.Value) = 1 Then
        Me.cmbReqTeam.AddItem thisCell.Value
    End If
Next thisCell

End Sub
Private Sub cmbReqTeam_Change()

Dim thisCell As Range

Me.cmbReqJob.Clear
For Each thisCell In Sheets("Lists").Range("team_list")
    If thisCell.Value = cmbReqTeam.Text Then
        Me.cmbReqJob.AddItem (thisCell.Offset(0, 1).Value)
    End If
Next thisCell

End Sub

Assuming you have another combo box called cmbReqJob then something like above should work for you. I removed the scripting dictionary requirement and I've assumed that the jobs are one column to the right of the teams.

WBD

 

[Mike_CS]

Thank you so much WBDixon

It's amazing what a few lines in the background can do when you think about it.

I can re-use this over and over again.

You have a Jam/Iced Ring Doughnut from Greggs on me.

Thanks again

Mike_CS, Liverpool

 

[wideboydixon]

Can I swap it for a sausage roll? :D

WBD

 

[Mike_CS]

Ha yes of course. but maybe the pound bakery as you get more dough for your dough. or pastry for your dough as would be the case.

Once again thanks mate.