What's New
Q & A
Tip Jar
C# Helper...
Follow VBHelper on Twitter
MSDN Visual Basic Community
TitleCreate a custom collection that supports For Each
Keywordscustom collection, For Each, enumerate, enumerator, NewEnum
CategoriesSoftware Engineering
Give the custom collection a private (normal) collection where it can store objects. Create Add, Remove, and other methods that you want to provide.
Private m_Employees As Collection

' Add an Employee object to the collection.
Public Sub Add(ByVal emp As Employee, Optional ByVal key As _
    If IsMissing(key) Then
        m_Employees.Add emp
        m_Employees.Add emp, key
    End If
End Sub

' Return the number of items in the collection.
Public Function Count() As Long
    Count = m_Employees.Count
End Function

' Remove an Employee object from the collection.
Public Sub Remove(ByVal Index As Variant)
    m_Employees.Remove Index
End Sub

' Return an Employee object.
Public Function Item(ByVal Index As Variant) As Employee
    Set Item = m_Employees(Index)
End Function
To make Item the collection's default method (so you can say "my_collection(key_value)" as you can with a normal collection):
  1. Select Tools\Procedure Attributes
  2. Select this function in the Name dropdown.
  3. Click Advanced.
  4. Select (Default) in the Procedure ID dropdown.

To allow For Each enumeration, create the following NewEnum function. In this example, m_Employees is the name of the custom collection's private (normal) Collection object.

Public Function NewEnum() As IUnknown
    Set NewEnum = m_Employees.[_NewEnum]
End Function
Next do the following:
  1. Open the collection class in the code designer.
  2. Select Tools\Procedure Attributes.
  3. Select this function in the Name dropdown.
  4. Click Advanced.
  5. Enter -4 as the Procedure ID.

Now the program can use For Each on the collection as in:

Private Sub ListEmployees()
Dim emp As Employee
Dim txt As String

    For Each emp In m_Employees
        txt = txt & emp.LastName & ", " & _
            emp.FirstName & vbCrLf
    Next emp
    txtEmployees.Text = txt
End Sub
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.