…could you please help me tweak the code so that I can make multiple selections in listbox 1 in such a way that the values selected in list box two has all the values applicable for the selections made (listbox) but removes all duplicates?
First, a word about that post. I have used the relationship listbox template exactly zero times. I simply prefer to build my classes from scratch with names that reflect the business objects they represent. But I did reuse the userform and I didn’t change the control names from Parent/Child to Class/Student. I’m conflicted about that, but I’ll get over it.
Let’s say we have some classes and students. A class can have many students and a student can have many classes.
When you select a class, the userform lists the students. If you select more than one class, the userform lists all the student from the selected classes, but each student is listed only once.
Andrew and Payton are only listed once.
There are some significant changes to the code, not the least of which is removing the grandchildren. Also instead of tracking ActiveParent (singular), I now track ActiveClasses (plural) because my top listbox is now multiselect. When my Parent listbox changes, I have to see all the classes that are selected.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
Private Sub lbxParents_Change() Dim clsClass As CClass Dim i As Long If Me.lbxParents.ListIndex <> -1 Then Set Me.ActiveClasses = New CClasses For i = 0 To Me.lbxParents.ListCount - 1 If Me.lbxParents.Selected(i) Then Me.ActiveClasses.Add Me.Classes.ClassByClassName(Me.lbxParents.List(i)) End If Next i Else Set Me.ActiveClasses = Nothing End If FillChildren End Sub Private Sub FillChildren() Me.lbxChildren.Clear If Not Me.ActiveClasses Is Nothing Then If Me.ActiveClasses.StudentCount > 0 Then Me.lbxChildren.List = Me.ActiveClasses.StudentList Me.lbxChildren.ListIndex = 0 End If End If End Sub |
To get a unique student list, I use a dictionary object. My favorite thing about dictionaries is returning a zero-based array from the Keys or Items properties.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Public Property Get StudentList() As Variant Dim clsClass As CClass Dim clsStudent As CStudent Dim dcReturn As Scripting.Dictionary Set dcReturn = New Scripting.Dictionary For Each clsClass In Me For Each clsStudent In clsClass.Students If Not dcReturn.Exists(clsStudent.StudentName) Then dcReturn.Add clsStudent.StudentName, clsStudent.StudentName End If Next clsStudent Next clsClass StudentList = dcReturn.Keys End Property |
You can check out the rest of the code in the downloadable file.
Posting code? Use <pre> tags for VBA and <code> tags for inline.