This was motivated by a question in the mrexcel.com forum. The person asking for help had multiple comboboxes in a userform, each of which contained the same items, A through L for the purpose of this exercise. These items were sorted alphabetically. He wanted that when the user selected an item in any of the comboboxes, that item would become unavailable in all of the other comboboxes. Further, if the user selected a new item in a combobox already containing a selection, the old item would be made available in the other comboboxes while still maintaining the sort order for the items. For the original request see http://www.mrexcel.com/forum/showthread.php?t=541741.
The 2 images below show the desired behavior. After ‘B’ is selected in the first dropdown, the choices for the other comboxes no longer include B. Then, after ‘F’ is selected in the second combobox, it is no longer available in the other comboboxes. So, the combined effect is that in the third combobox neither B nor F is available.
Figure 1
In this note, I show how to create a class that functionally extends the capability of a combobox. By using a class, the solution is very scalable, and it is possible to accommodate an arbitrary number of comboboxes. For example, to add another combobox, add it to the userform…and you are done! By comparison, the more traditional “brute force” approach (described at the end of the note) requires changes in four areas of the code to accommodate a new combobox.
Figure 2
At its core, we add a class module, named clsComboBox, that includes a ‘withevents’ combobox variable and then add the additional properties and methods to this class. So, what are the new attributes?
Clearly, we have to be able to add an item to the list – and put it in the correct position so that the list is always alphabetically sorted. Similarly, we have to be able to remove a specific item from the combobox’s drop down list.
Option Explicit
Dim WithEvents xComboBox As MSForms.ComboBox
Property Set ComboBox(uComboBox As MSForms.ComboBox)
Set xComboBox = uComboBox
End Property
Property Get ComboBox() As MSForms.ComboBox
Set ComboBox = xComboBox
End Property
Sub addItem(X As String)
Dim I As Integer
With Me.ComboBox
For I = 0 To .ListCount - 1
If .List(I) > X Then .addItem X, I: GoTo Done
Next I
.addItem X
End With
Done:
End Sub
Sub removeItem(X As String)
With Me.ComboBox
If X > .List(.ListCount - 1) Then GoTo XIT
Dim I: I = 0
Do While I < .ListCount And .List(I) < X: I = I + 1: Loop
If .List(I) = X Then .removeItem I
End With
XIT:
End Sub
Code Sample 1
There’s one other thing that we have to do. When the user selects an item from this combobox, we have to (a) if there was an earlier selection, reinstate that choice in the other comboboxes and (b) remove the current choice from the other comboboxes.
To accomplish this, first we have to have a list of all the enhanced comboboxes. We use a property that the consumer of the class updates.
Dim xAllComboBoxes() As clsComboBox
Property Let AllComboBoxes(uAllComboBoxes() As clsComboBox)
xAllComboBoxes = uAllComboBoxes
End Property
Property Get AllComboboxes() As clsComboBox()
AllComboboxes = xAllComboBoxes
End Property
Code Sample 2
Now that we have a list of all the comboboxes, we have to respond to a user selection with our combobox. Remember, we want to reinstate in all the other comboboxes the last selection, if any, and then remove the current selection. Since the list of comboboxes includes the one in this object, we have to exclude it from the updates performed by the addToAll and removeFromAll routines.
Dim LastVal As String
Private Sub xComboBox_Change()
If LastVal <> "" Then addToAll LastVal
With Me.ComboBox
LastVal = .Value
removeFromAll .Value
End With
End Sub
Sub addToAll(ByVal X As String)
Dim I As Integer
Dim AllComboboxes() As clsComboBox: AllComboboxes = Me.AllComboboxes()
For I = LBound(AllComboboxes) To UBound(AllComboboxes)
With AllComboboxes(I)
If .ComboBox.Name <> Me.ComboBox.Name Then .addItem X
End With
Next I
End Sub
Sub removeFromAll(ByVal X As String)
Dim I As Integer
Dim AllComboboxes() As clsComboBox: AllComboboxes = Me.AllComboboxes()
For I = LBound(AllComboboxes) To UBound(AllComboboxes)
With AllComboboxes(I)
If .ComboBox.Name <> Me.ComboBox.Name Then .removeItem X
End With
Next I
End Sub
Code Sample 3
For the sake of completeness, the entire class is reproduced below.
Option Explicit
Dim WithEvents xComboBox As MSForms.ComboBox
Dim xAllComboBoxes() As clsComboBox
Dim LastVal As String
Property Set ComboBox(uComboBox As MSForms.ComboBox)
Set xComboBox = uComboBox
End Property
Property Get ComboBox() As MSForms.ComboBox
Set ComboBox = xComboBox
End Property
Property Let AllComboboxes(uAllComboBoxes() As clsComboBox)
xAllComboBoxes = uAllComboBoxes
End Property
Property Get AllComboboxes() As clsComboBox()
AllComboboxes = xAllComboBoxes
End Property
Private Sub xComboBox_Change()
If LastVal <> "" Then addToAll LastVal
With Me.ComboBox
LastVal = .Value
removeFromAll .Value
End With
End Sub
Sub addToAll(ByVal X As String)
Dim I As Integer
Dim AllComboboxes() As clsComboBox: AllComboboxes = Me.AllComboboxes()
For I = LBound(AllComboboxes) To UBound(AllComboboxes)
With AllComboboxes(I)
If .ComboBox.Name <> Me.ComboBox.Name Then .addItem X
End With
Next I
End Sub
Sub removeFromAll(ByVal X As String)
Dim I As Integer
Dim AllComboboxes() As clsComboBox: AllComboboxes = Me.AllComboboxes()
For I = LBound(AllComboboxes) To UBound(AllComboboxes)
With AllComboboxes(I)
If .ComboBox.Name <> Me.ComboBox.Name Then .removeItem X
End With
Next I
End Sub
Sub addItem(X As String)
Dim I As Integer
With Me.ComboBox
For I = 0 To .ListCount - 1
If .List(I) > X Then .addItem X, I: GoTo Done
Next I
.addItem X
End With
Done:
End Sub
Sub removeItem(X As String)
With Me.ComboBox
If X > .List(.ListCount - 1) Then GoTo XIT
Dim I: I = 0
Do While I < .ListCount And .List(I) < X: I = I + 1: Loop
If .List(I) = X Then .removeItem I
End With
XIT:
End Sub
Code Sample 4
All of the functionality of the enhanced combobox is contained in the class module described above. Consequently, the responsibility of the consumer of this class is limited to correctly instantiating the objects. The code in the userform module is shown below. It assumes that every combobox in the userform will contain the sorted A…L list and will demonstrate the behavior supported by the clsComboBox class.
In the first For I=… loop in the Initialize event procedure, the code loads each combobox with the A…L list and initializes the module level variable AllComboboxes with the enhanced combobox objects. The second For I=… loop updates each of the objects with the complete list of all of the objects.
Option Explicit
Dim AllComboboxes() As clsComboBox
Function ComboBoxCount() As Integer
Dim I As Integer
For I = 0 To Me.Controls.Count - 1
If TypeOf Me.Controls(I) Is MSForms.ComboBox Then _
ComboBoxCount = ComboBoxCount + 1
Next I
End Function
Private Sub UserForm_Initialize()
Dim ComboBoxCount: ComboBoxCount = Me.ComboBoxCount()
ReDim AllComboboxes(ComboBoxCount - 1)
Dim I As Integer, J As Integer, _
ComboBoxIdx As Integer
For I = 0 To Me.Controls.Count - 1
If TypeOf Me.Controls(I) Is MSForms.ComboBox Then
For J = 1 To 12
Me.Controls(I).addItem Chr(Asc("A") + J - 1)
Next J
Set AllComboboxes(ComboBoxIdx) = New clsComboBox
Set AllComboboxes(ComboBoxIdx).MyComboBox = Me.Controls(I)
ComboBoxIdx = ComboBoxIdx + 1
End If
Next I
For I = 0 To ComboBoxCount - 1
AllComboboxes(I).AllComboboxes = AllComboboxes
Next I
End Sub
Code Sample 5
As mentioned earlier, to add another combobox requires no code changes. Simply add the combox to the design of the userform and you are set to go!
Figure 3
For comparison purposes, here is a brute force solution that met the immediate requirements of the original requester. The code below goes in the userform’s code module and is relatively easy to understand but it comes with a major restriction. The solution requires changes in four areas of the code whenever one adds a new combobox. First, the combobox (though the code below uses listboxes) requires its own change event procedure. Second, we have to modify the change procedure for every existing combobox. Third, we have to modify the Initialize procedure. Finally, we have to modify the FillWhileChecking procedure.
Dim ufEventsDisabled As Boolean
Private Sub ListBox1_Change()
If ufEventsDisabled Then Exit Sub
Call FillWhileChecking(ListBox2)
Call FillWhileChecking(ListBox3)
End Sub
Private Sub ListBox2_Change()
If ufEventsDisabled Then Exit Sub
Call FillWhileChecking(ListBox1)
Call FillWhileChecking(ListBox3)
End Sub
Private Sub ListBox3_Change()
If ufEventsDisabled Then Exit Sub
Call FillWhileChecking(ListBox1)
Call FillWhileChecking(ListBox2)
End Sub
Sub FillWhileChecking(aListbox As MSForms.ListBox)
Dim i As Long
Dim nextEntry As String
ufEventsDisabled = True
With aListbox
.Tag = .Text
.Clear
For i = 0 To 25
nextEntry = Chr(65 + i)
If (nextEntry <> ListBox1.Text) And (nextEntry <> ListBox2.Text) And (nextEntry <> ListBox3.Text) Then
.AddItem nextEntry
If nextEntry = .Tag Then .Tag = .ListCount - 1
End If
Next i
If IsNumeric(.Tag) Then .ListIndex = Val(.Tag)
End With
ufEventsDisabled = False
End Sub
Private Sub UserForm_Initialize()
Call FillWhileChecking(ListBox1)
Call FillWhileChecking(ListBox2)
Call FillWhileChecking(ListBox3)
End Sub
Code Sample 6
