Home > Excel VBA macros > Your own collections

How to make your own collections in Excel VBA

There are many built-in collections in Excel (and other Office programs), and it is easy to make your own. Further down the page are examples that do just that, but first a few words about collections - what is a collection?

A collection is a group of objects that don't have to be the same data type. Excel has many built-in collections. For instance a workbook has a collection of worksheets, a worksheet has a collection of cells and so on.

In VBA you can address/refer to a worksheet by its number in the collection. For instance:

ActiveWorkbook.Worksheets(1).Visible

If you have named the sheet, you can also refer to it by name.

ActiveWorkbook.Worksheets("Data").Visible

There are many more built-in collections in Excel. For instance all control elements on a userform are items in the form's control elements collection.

Collections are not unlike arrays, because they contain a collection of objects that can be referenced with a numeric index, but collections are easier to handle, because they have some built-in methods to add, remove and reference the items.

You can add and remove objects, and you can loop through a collection using the fast "For Each...Next" loop. Every element (item) in a collection can have a key (optional name), which must be unique.

All collections have in common that you can add and remove items or be told, how many items there are in the collection:

colMyCollection.Add  item, key, before, after
colMyCollection.Remove item, key
colMyCollection.Count

When you add an element, "item" is required, and it is the value returned when you ask for it. "Key" is an optional name. You don't have to name the item, but it can be very practical.The key must be unique and it must be a String (data type).

"Before" and "after" are used, if the new element shouldn't be added as the last item, but somewhere else in between.

Collection examples

The first example is very simple. The procedure reads the values in cell A1 and down, until it meets the first empty cell. After that it writes the values in cell C1 and down.

You can highlight/select the code using the mouse and copy (CTRL+C) it into a VBA module. Remember to write something in cell A1 and down - otherwise nothing will happen.

In the second example we only add unique values to our collection, and they are sorted alphabetically. But first the simple example:

Sub SimpleCollection()
'This procedure reads the values in cell A1 and down to
'the first empty cell and add them to a collection.
'After that the values are written to cell C1 and down.

Dim colMyCol As New Collection 'Our collection
Dim vElement                   'Variant to represent an element
Dim rRange As Range            'Range variable
Dim rCell As Range             'Range variable
Dim lCount As Long             'Counter

Set rRange = Range("A1")

'If cell A1 is empty we cancel and leave the procedure.
If Len(rRange.Value) = 0 Then GoTo BeforeExit

'If there is anything in A2, we expand rRange to the last empty cell.
If Len(rRange.Offset(1, 0).Value) > 0 Then
   Set rRange = Range(rRange, rRange.End(xlDown))
End If

'Now the cell values are added to the collection.
'Notice that we DON'T give the items a name (key).
For Each rCell In rRange
   colMyCol.Add rCell.Value
Next

'Now we write the values to cell C1 and down.
'Just like a range a collection can be looped with
'For Each...Next.
For Each vElement In colMyCol
   Range("C1").Offset(lCount, 0).Value = vElement
   lCount = lCount + 1
Next

BeforeExit:
Set colMyCol = Nothing
Set rRange = Nothing
Set rCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Error in procedure _
SimpleCollection"
Resume BeforeExit
End Sub

Now that was easy. The next example is more advanced. It will only add unique values, and the values will be sorted alphabetically.

We do the unique value trick by adding the value as a name (key) too. In collections keys must be unique, and if you try to add a key that exists already, you will get an error. We get around this by using "On Error Resume Next".

We sort alphabetically by using the mathematical "<" less than, and then add the value before values later in the alphabet.

Insert the following in cell A1 and down. Copy the code to a VBA module.

London
Antwerp
1
New York
Antwerp
4
Bombay

Sub AdvancedCollection()
'Adds unique values from a column to a collection
'in alphabetical order
Dim colMyCol As New Collection 'Our collection
Dim rRange As Range            'Range variable
Dim rCell As Range             'Range variable
Dim lCount As Long             'Counter
Dim sVar As String             'String variable for the keys

On Error GoTo ErrorHandle

'We set our range = cell A1
Set rRange = Range("A1")

'If A1 is empty, we abort.
If Len(rRange.Value) = 0 Then GoTo BeforeExit

'If there is anything in cell A2, we extend the range to
'the last cell with content.
If Len(rRange.Offset(1, 0).Value) > 0 Then
   Set rRange = Range(rRange, rRange.End(xlDown))
End If

'By writing On Error Resume Next now we avoid a crash, if we
'try adding an existing key. Instead the program will just
'skip the item, and we get unique values only.
On Error Resume Next

'Now we loop through the range
For Each rCell In rRange
   'A key must be a String. so if the cell
   'contains a numeric value, we convert it to a string.
   If IsNumeric(rCell.Value) Then
      sVar = Str$(rCell.Value)
   Else
      sVar = rCell.Value
   End If

   'Now the values are added to the collection.
   'We use With..End for speed.
   With colMyCol
      'If the collection isn't empty
      If .Count > 0 Then
         'We loop the collection, and the new value
         'is compared alphabetically with the others
         'and added at the right place before.
         'Alphabetic sequence, dates and such stuff
         'can be checked with the operators < > and =.
         For lCount = 1 To .Count
            If rCell.Value < .Item(lCount) Then
               .Add rCell.Value, sVar, lCount
               Exit For
            End If
         Next
      End If

      'If the collection is empty, or if
      'the counter shows that the value should be added as the
      'last item, we add the value as the last item.
      If lCount = .Count + 1 Or .Count = 0 Then
         .Add rCell.Value, sVar
      End If
   End With
Next

On Error GoTo ErrorHandle

'To finish the example we now insert the sorted values
'in cell D1 and down.
Set rRange = Range("D1")

With colMyCol
   For lCount = 0 To .Count
      rRange.Offset(lCount, 0).Value = .Item(lCount + 1)
   Next
End With

BeforeExit:
Set colMyCol = Nothing
Set rRange = Nothing
Set rCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Error in procedure AdvancedCollection"
Resume BeforeExit
End Sub

Tip

VBA distinguishes between lower and upper case, and if a word starts with lower case, it will go to the bottom. You can avoid that by writing:

Option Compare Text

at the top of the VBA module. This forces VBA not to use the default binary comparison.

Related: