Collection Add and Functions

When I was creating sample data for Returning a Limited Collection…, I had to fill a bunch of collections with custom classes. Instead of creating the class and adding it to the collection, I created a function that returned the class and use the function call in the Add method. Here’s an example:

Set clsGroup = New CGroup
clsGroup.Name = “Group1”
Set colContacts = New Collection
colContacts.Add CreateContact(“Dick Kusleika”, _
    “Company1”, “NE”), “Dick Kusleika”
colContacts.Add CreateContact(“John Doe”, _
    “Company2”, “NE”), “John Doe”
colContacts.Add CreateContact(“Jane Doe”, _
    “Company2”, “MA”), “Jane Doe”
Set clsGroup.Contacts = colContacts
colGroups.Add clsGroup, clsGroup.Name

The CreateContact function looks like this:

Function CreateContact(sName As String, sCompany As String, _
    sState As String) As CContact
   
    Dim clsCon As CContact
   
    Set clsCon = New CContact
   
    clsCon.Name = sName
    clsCon.Company = sCompany
    clsCon.State = sState
   
    Set CreateContact = clsCon
   
End Function

I never thought of calling a function directly from the Add method of a Collection, but I can’t think of any reason not to do it.

Posted in Uncategorized

5 thoughts on “Collection Add and Functions

  1. Hi Dick:

    When creating a class consider putting as much of the functionality into the class rather than relying on the client doing things correctly. For example, I would have the parent class add a single element object not an entire collection since one doesn’t know what is in the collection.

    So, clsParent would contain:

    Option Explicit

    Dim AllElements As Collection

    Public Sub addElement(Ele As clsElement)
        On Error Resume Next
        AllElements.Add Ele, Ele.Key
        End Sub

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

    For the sake of simplicity I assumed that clsElement has a Key. But, PED shows how to generalize the idea.

    I would even put the responsibility of listing all the elements into the class with

    Public Function ListAll() As String
        Dim vEle As Variant, Ele As clsElement
        For Each vEle In AllElements
            Set Ele = vEle
            ListAll = ListAll & Ele.Key & “=” & Ele.Val & vbNewLine
            Next vEle
        End Function

    Now, if we have an element class named clsElement containing

    Option Explicit

    Dim sKey As String, sVal As String

    Property Let Key(uKey As String): sKey = uKey: End Property
    Property Get Key() As String: Key = sKey: End Property

    Property Let Val(uVal As String): sVal = uVal: End Property
    Property Get Val() As String: Val = sVal: End Property

    we would use the above with code in a standard module as in

    Option Explicit

    Dim aParent As clsParent

    Function addEle(ByVal Key As String, ByVal Val As String) As clsElement
        Dim Ele As New clsElement
        Ele.Key = Key
        Ele.Val = Val
        Set addEle = Ele
        End Function
    Sub demoClasses()
        Set aParent = New clsParent
        aParent.addElement addEle(“1”, “One”)
        aParent.addElement addEle(“2”, “Two”)
        Debug.Print aParent.ListAll
        Set aParent = Nothing
        End Sub

    One thing that VB doesn’t support is overloading functions. That is why we cannot use something like

    dim anEle as clsElement
    set anEle = new clsElement (“1”, “One”)
    aParent.addelement anEle

    or even better

    aParent.addelement new clsElement (“1”, “One”)

    But, we can do something similar with the following:

    Add to clsElement:

    Public Sub Init(ByVal Key As String, Val As String)
        Me.Key = Key: Me.Val = Val
        End Sub

    Now, the standard module code could be shortened to

    Option Explicit

    Dim aParent As clsParent

    Function addEle(ByVal Key As String, ByVal Val As String) As clsElement
        Set addEle = New clsElement: addEle.Init Key, Val
        End Function
    Sub demoClasses()
        Set aParent = New clsParent
        aParent.addElement addEle(“1”, “One”)
        aParent.addElement addEle(“2”, “Two”)
        Debug.Print aParent.ListAll
        Set aParent = Nothing
        End Sub

    We can take it a step further approaching

    aParent.addelement new clsElement (“1”, “One”)

    with the following:

    In the clsElement class replace the Init sub with

    Public Function Init(ByVal Key As String, Val As String) As clsElement
        Me.Key = Key: Me.Val = Val
        Set Init = Me
        End Function

    Now with a function that creates an empty object, the code in the standard module becomes

    Option Explicit

    Dim aParent As clsParent

    Function newClsElement() As clsElement
        Set newClsElement = New clsElement
        End Function
    Sub demoClasses()
        Set aParent = New clsParent
        aParent.addElement newClsElement.Init(“1”, “One”)
        aParent.addElement newClsElement.Init(“2”, “Two”)
        Debug.Print aParent.ListAll
        Set aParent = Nothing
        End Sub

    This, the use of a function to create an empty object, is how one can also use a class declared in another workbook/addin. See
    How to use a class (object) from outside of the VBA project in which it is declared
    http://support.microsoft.com/kb/555159

  2. A variation:

    Contact is the simplest class, defacto a user defined type.
    Group does the handling of creating the contact objects.
    Group has Enumeration to enable for/each.
    (needs editing on exported module to set the attributes)

    ‘Module1
    Option Explicit

    Sub Test()
      Dim Groups                    As Collection
      Dim Group                     As CGroup
      Dim Contact                   As CContact

      Set Groups = GetGroups

      For Each Group In Groups
        For Each Contact In Group
          If Contact.State = “NE” Then
            With Contact
              Debug.Print Group.Name, .State, .Name, .Company
            End With
          End If
        Next
      Next
    End Sub

    Function GetGroups() As Collection
        Dim Group As CGroup
       
        Set GetGroups = New Collection
       
        Set Group = New CGroup
        With Group
          .Name = “Group1”
          .AddContact “Dick Kusleika”, “Company1”, “NE”
          .AddContact “John Doe”, “Company2”, “NE”
          .AddContact “Jane Doe”, “Company2”, “MA”
        End With
        GetGroups.Add Group, Group.Name

        Set Group = New CGroup
        With Group
        .Name = “Group2”
        .AddContact “Ed Poe”, “Company3”, “AZ”
        .AddContact “Bill Shakes”, “Company2”, “OR”
        .AddContact “Emily Bronte”, “Company4”, “FL”
        End With
        GetGroups.Add Group, Group.Name

        Set Group = New CGroup
        With Group
        .Name = “Group3”
        .AddContact “Henry Ford”, “Company5”, “MI”
        .AddContact “Andy Carnegie”, “Company5”, “NE”
        .AddContact “Johnny Rocky”, “Company4”, “NY”
        End With
        GetGroups.Add Group, Group.Name

    End Function

    ‘PublicNotCreatable Class CContact
    Public Name As String
    Public Company As String
    Public State As String

    ‘PublicNotCreatable Class CGroup
    Option Explicit

    Dim myContacts                  As Collection
    Public Name                     As String

    Sub AddContact(Name As String, Company As String, State As String)
      Dim Contact                   As CContact
      Set Contact = New CContact
      Contact.Name = Name
      Contact.Company = Company
      Contact.State = State

      If Len(Name) = 0 Then
         Err.Raise -1, , “Contact Name must be supplied”
      Else
         myContacts.Add Contact, Contact.Name
      End If

    End Sub

    Function Contact(Index As Variant) As CContact
    ‘Attribute Contact.VB_UserMemId = 0
     Set Contact = myContacts.Item(Index)
    End Function

    Function NewEnum() As IUnknown
    ‘Attribute NewEnum.VB_UserMemId = -4
    ‘Attribute NewEnum.VB_MemberFlags = “40”
     Set NewEnum = myContacts.[_NewEnum]
    End Function

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

  3. I’d say the create-in-a-function idea is an instance of a “Factory Method”. Or the VBA equivalent. It’s about the best we can do in a COM-influenced world where we don’t get parameterised constructors.

    I do like – and often use – the idea from keepItCool: building a custom collection class, even though it needs a little external hacking to get enumeration working (I’m sure someone like Rob Bovey could extend VBE to export, hack and reimport the class…)

  4. Hi there,
    I tried the above slice of cade in excel and it stops at the following line with a runtime error ‘438’ not being able to supportthe Contect property.

    “For Each Contact In Group”

    Any idea why this is stopping here?

    Cheers

    Ads


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.