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:
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:
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
Sub ShowCombos()
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
Public sKey As String
Private mcolArrays As Collection
Public Function Add(Key As String, Optional sKey As String) As clArray
On Error GoTo ErrorHandle
Dim objNewMember As clArray
Set objNewMember = New clArray
objNewMember.Key = Key
If Len(sKey) = 0 Then
mcolArrays.Add objNewMember
Else
mcolArrays.Add objNewMember, sKey
End If
Set Add = objNewMember
Set objNewMember = Nothing
Exit Function
ErrorHandle:
MsgBox Err.Description & ", Function Add, clArrays"
End Function
Public Sub Remove(vntIndexKey As Variant)
mcolArrays.Remove vntIndexKey
End Sub
Private Sub Class_Initialize()
Set mcolArrays = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolArrays = Nothing
End Sub
Public Property Get Item(vntIndexKey As Variant) As clArray
Set Item = mcolArrays(vntIndexKey)
End Property
Public Property Get Count() As Long
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
Public sKey As String
Private marArray()
Private Sub Class_Terminate()
Erase marArray
End Sub
Sub RangeToArray(ByRef rRange As Range)
ClassArray = rRange.Value
End Sub
Sub DimensionArray(ByVal lRows As Long, ByVal lCols As Long)
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
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)
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()
Dim lCount As Long
Dim lRow As Long
Dim dCount2 As Double
Dim rInput As Range
Dim arTable()
Dim colAuthors As New Collection
Dim vAuthor As Variant
Set rInput = Range("A2", Range("A2").End(xlDown).Offset(0, 1))
arTable = rInput.Value
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
ArraysCol.Add "Authors", "Authors"
With ArraysCol.Item("Authors")
.DimensionArray colAuthors.Count, 1
For lCount = 1 To colAuthors.Count
.ClassArray(lCount, 1) = colAuthors.Item(lCount)
Next
End With
For Each vAuthor In colAuthors
ArraysCol.Add CStr(vAuthor), CStr(vAuthor)
dCount2 = _
Application.WorksheetFunction.CountIf(rInput.Columns(2), vAuthor)
With ArraysCol.Item(vAuthor)
.DimensionArray dCount2, 1
lRow = 0
For lCount = 1 To UBound(arTable)
If arTable(lCount, 2) = vAuthor Then
lRow = lRow + 1
.ClassArray(lRow, 1) = arTable(lCount, 1)
End If
Next
End With
Next
With ComboBox1
.List = ArraysCol.Item("Authors").ClassArray
.Text = .List(0)
.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()
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 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:
|