Extend an object’s attributes to coordinate multiple userform controls

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.

Download the XLSM file.

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

 

Using a class to functionally extend the combobox attributes

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

The complete class

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

Using the clsCombobox class

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

Add another combobox

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

The brute force approach

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