RSS

Class arrays for dependent ComboBoxes

This page shows how the selection in one combobox can control the content of another. It also shows how to manage a dynamic number of arrays by storing them in a class collection. You can download an Excel workbook with the macro code.

I have often preached the blessings of using arrays for fast processing of data, but what if you don't know how many arrays you need?

You can add arrays to a collection, but what you add is a copy of an array, and as far as I know, you cannot manipulate the array in the collection.

However if you make a class collection, where each class has an array, you can add as many arrays as you need - you just add an array class to the collection. It may sound complicated, but in fact it is quite easy, and your code will be nicely structured.

The books and authors example

Imagine a list of books and authors like the snippet below:

Books and authors

The list can be much longer, and instead of books and authors it could be items and groups like "Personal care" or "Power tools" - whatever.

You want the stuff in two ComboBoxes on a userform, authors in ComoBox1, and the books by the selected author in ComboBox2. Like this:

ComboBox

There are different ways to fill the list of a ComboBox (see my page about listboxes). In a case like this it is difficult to use RowSource, and the AddItem method would be slow, if the list is long.

Here the ideal list source would be an array. Then you fill the list in ComboBox2 (book titles) by writing:

ComboBox2.List = myArrayX

However you would need to know the number of authors to declare the number of book arrays, and what if you add some authors to the list? Do you want to rewrite the code and find new variable names for every new array?

Of course not; you need the ability to manage a dynamic number of arrays.

The solution is to put the arrays in a class collection, and below I show you how to do that. You can download a workbook with the whole lot, which actually isn't a lot!

You need one standard VBA module, two class modules and a userform with two comboboxes.

In an ordinary (standard) module, I have the following code.


Option Explicit
Public ArraysCol As clArrays  'The class collection

Sub ShowCombos()
'Show the userform. Classes and arrays are
'created by the UserForms Initialize procedure.
UserForm1.Show
End Sub

Now before we move on to the userform, let us see the class collection and the array class. First the class collection (in a class module):


Option Explicit
Public Key As String             'Key
Public sKey As String            'Secondary key
Private mcolArrays As Collection 'The collection of classes with an array

Public Function Add(Key As String, Optional sKey As String) As clArray
'Add an Array class to the class collection.

    On Error GoTo ErrorHandle
        
    'Make a new object of the class clArray
    Dim objNewMember As clArray
    Set objNewMember = New clArray

    'Assigns a key to the new object
    objNewMember.Key = Key

    If Len(sKey) = 0 Then
        mcolArrays.Add objNewMember
    Else
        mcolArrays.Add objNewMember, sKey
    End If

    'Add the new object to the collection
    Set Add = objNewMember
    'The class is now copied to the collection, and
    'we can destroy the old "stand alone" object
    Set objNewMember = Nothing

Exit Function
ErrorHandle:
MsgBox Err.Description & ", Function Add, clArrays"
End Function

Public Sub Remove(vntIndexKey As Variant)
    'Removes a class from the class collection
    mcolArrays.Remove vntIndexKey
End Sub

Private Sub Class_Initialize()
    Set mcolArrays = New Collection
End Sub

Private Sub Class_Terminate()
    Set mcolArrays = Nothing
End Sub
'***********************************************************
'Properties section
'***********************************************************
Public Property Get Item(vntIndexKey As Variant) As clArray
  Set Item = mcolArrays(vntIndexKey)
End Property

Public Property Get Count() As Long
   'Returns the number of classes in the collection
    Count = mcolArrays.Count
End Property

In the combobox example I don't use all the above (e.g. the Get Count property), but they may be useful to you.

Next the array class (also a class module). We can add any number of this to our class collection, and if need be we can also remove classes:


Option Explicit
Public Key As String    'Key
Public sKey As String   'Secondary key
Private marArray()      'The array

Private Sub Class_Terminate()
   Erase marArray
End Sub

Sub RangeToArray(ByRef rRange As Range)
   'Not used in this example, but can be
   'used for copying the values in a range
   'to the array in one swift operation.
   ClassArray = rRange.Value
End Sub

Sub DimensionArray(ByVal lRows As Long, ByVal lCols As Long)
   'Redimensions the array
   ReDim marArray(1 To lRows, 1 To lCols)
End Sub

Public Property Get ClassArray(Optional _
ByVal i As Long, Optional ByVal y As Long) As Variant
    'Get a value or all values
    If i = 0 Or y = 0 Then
        ClassArray = marArray
    Else
        ClassArray = marArray(i, y)
    End If
End Property

Public Property Let ClassArray(Optional _
ByVal i As Long, Optional ByVal y As Long, ByVal vData As Variant)
    'Put values into the array
    If i = 0 Or y = 0 Then
        marArray = vData
    Else
        marArray(i, y) = vData
    End If
End Property

There are more ways of defining classes and class properties, but this way is a solid way by keeping the encapsuled items (array in this case) private instead of public. For other purposes it makes it easier to build in security.

So far we have a standard module, a class collection and the class for the collection. The last part is our userform with the two comboboxes and an OK button.

Here is the code for the userform:


Option Explicit

Private Sub UserForm_Initialize()
'This procedure executes before
'the userform opens.
Dim lCount As Long               'Counter
Dim lRow As Long                 'Counter
Dim dCount2 As Double            'Counter
Dim rInput As Range              'Input range
Dim arTable()                    'Array for input table values
Dim colAuthors As New Collection 'Collection with author names
Dim vAuthor As Variant           'Variable for author name

'Set rInput = the range with books and authors
Set rInput = Range("A2", Range("A2").End(xlDown).Offset(0, 1))

'Copy the range to the array, arTable, for speed
arTable = rInput.Value

'Make a list of authors. By using a second key,
'the author name will only be added once.
'Adding a duplicate triggers an error, and
'that is why we now write: On Error Resume Next
On Error Resume Next

For lCount = 1 To UBound(arTable)
   colAuthors.Add arTable(lCount, 2), arTable(lCount, 2)
Next

On Error GoTo ErrorHandle

Set ArraysCol = New clArrays

'Now we add an array with author names
'to the class collection, ArraysCol.
'This array is used as source for ComboBox1.
'One could also loop the colAuthor
'collection and use the AddItem method
'to ComboBox1, but now we are playing
'with arrays, so let us go all the way.
ArraysCol.Add "Authors", "Authors"

With ArraysCol.Item("Authors")
   'Dimension the array by calling the class'
   'DimensionArray procedure.
   .DimensionArray colAuthors.Count, 1
   'Add the author names to the array
   For lCount = 1 To colAuthors.Count
      .ClassArray(lCount, 1) = colAuthors.Item(lCount)
   Next
End With

'Add an array class for every author and
'fill it with the titles of his/her books
For Each vAuthor In colAuthors
   'The class gets the author name as key.
   'In that way the selected author in
   'ComboBox1 is the key to the class
   'with his/her book titles, and when an
   'author is selected in ComboBox1, the
   'ComboBox1_Change procedure will automatically
   'update the list in ComboBox2 by setting the
   'list = the array in the class that has the
   'author name as key.
   ArraysCol.Add CStr(vAuthor), CStr(vAuthor)
   'Use the worksheetfunction CountIf to get
   'the number of records with the same author.
   'CountIf requires a range and doesn't work
   'with arrays.
   dCount2 = _
   Application.WorksheetFunction.CountIf(rInput.Columns(2), vAuthor)
   'Dimension the book array
   With ArraysCol.Item(vAuthor)
      .DimensionArray dCount2, 1
      'Reset counter
      lRow = 0
      'Loop the arTable array and add titles
      'to the author's book array.
      For lCount = 1 To UBound(arTable)
         If arTable(lCount, 2) = vAuthor Then
            lRow = lRow + 1
            'Add the book title
            .ClassArray(lRow, 1) = arTable(lCount, 1)
         End If
      Next
   End With
Next

'Add the authors to ComboBox1. The change
'event will automatically trigger the
'ComboBox1_Change procedure and fill
'ComboBox2 with book titles.
With ComboBox1
   .List = ArraysCol.Item("Authors").ClassArray
   .Text = .List(0)
   'Match required. We don't want the user to
   'type an author name not on the list.
   .MatchRequired = True
End With

BeforeExit:
On Error Resume Next
Set rInput = Nothing
Set colAuthors = Nothing
Set vAuthor = Nothing
Erase arTable

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure UserForm_Initialize"
Resume BeforeExit
End Sub

Private Sub ComboBox1_Change()
   'The list in ComboBox2 gets the titles
   'from the author's book array
   With ComboBox2
      .List = ArraysCol.Item(ComboBox1.Text).ClassArray
      .Text = .List(0)
   End With
End Sub

Private Sub CommandButton1_Click()
MsgBox "Write you own code based on the user's selection"
Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Set the class collection to nothing
Set ArraysCol = Nothing
End Sub

Now you have one combobox controlling the content (list) of another, and knowing how to make a dynamic number of arrays can be very useful. In this example you can just add new authors and titles to the list, and the comboboxes will adjust automatically.

Instead of comboboxes you could use listboxes - the methods and properties are very much alike.

Related: