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

5. Ads,

   You need to export the Group class and edit the bas file, as KeepItCool mentions
   Quote:”Group has Enumeration to enable for/each.
   (needs editing on exported module to set the attributes)”

   See Chip’s page on the subject.
   http://www.cpearson.com/excel/DefaultProperty.htm

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