Making Custom Collection in Excel VBA

Question

I'm working on making a customer collection class that contains functions for if it contains an object, or if you want to remove a specific object. But I'm wondering if there is a way to call an object at a location though.

Here is an example:

If I want the 2nd object in a normal collection, I'd do this coll(2) and I'd get the 2nd object.

How can I use similar nomenclature for a custom class? Here is my custom class.

Option Explicit

Private Const modName = "CollectionClass"

Private zCollection As New Collection

Property Get coll() As Collection
    Set coll = zCollection
End Property

Public Function Count() As Variant

10      On Error GoTo SUB_ERR

20      Count = zCollection.Count

SUB_EXIT:
30      Exit Function

SUB_ERR:
40      ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": Count"

End Function

Public Sub Add(var As Variant)

10      On Error GoTo SUB_ERR

20      zCollection.Add var

SUB_EXIT:
30      Exit Sub

SUB_ERR:
40      ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": Add"

End Sub

Public Sub Remove(loc As Long)

10      On Error GoTo SUB_ERR

20      zCollection.Remove loc

SUB_EXIT:
30      Exit Sub

SUB_ERR:
40      ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": Remove"

End Sub

Public Sub RemoveObj(var As Variant)

10      On Error GoTo SUB_ERR

20      Dim i As Long

30      If IsMissing(var) Then
40          Dim xxx As Integer: xxx = 1000000 'Errors if no var sent
50      Else
60          Select Case TypeName(var)
                Case "PartClass"
70                  Dim part As PartClass
80                  i = 1
90                  For Each part In zCollection
100                     If part Is var Then
110                         Me.Remove i
120                         Exit Sub
130                     End If
140                     i = i + 1
150                 Next
160             Case Else
170                 xxx = 1000000 'Errors if unknown Type Name
180         End Select
190     End If

SUB_EXIT:
200     Exit Sub

SUB_ERR:
210     ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": RemoveObj"

End Sub

Public Function Contains(var As Variant) As Boolean

10      On Error GoTo FUNC_ERR

30      If IsMissing(var) Then
40          Dim xxx As Integer: xxx = 1000000 'Errors if no var sent
50      Else
60          Select Case TypeName(var)
                Case "PartClass"
70                  Dim part As PartClass
90                  For Each part In zCollection
100                     If part Is var Then
110                         Contains = True
120                         Exit Function
130                     End If
150                 Next
160             Case Else
170                 xxx = 1000000 'Errors if unknown Type Name
180         End Select
190     End If

FUNC_EXIT:
200     Exit Function

FUNC_ERR:
210     ProcessError errorNumber:=Err.Number, _
                     errorDescription:=Err.Description, _
                     errorLine:=Erl, _
                     errorInRoutine:=modName & ": Contains"

End Function

So if I have an instance of my custom collection custColl, currently, I have to use this to get the 2nd object custColl.Coll(2), but I'm wondering if there is a way to make it so I can just do custColl(2)

Thank you for the help! Jason

Answer 1

Actually, I thought about the default property thing afterwards (same as identified by Hel) and it actually is possible and I've tested it.

You just need to write a function that takes an integer argument to return the desired value from the collection; and set it to be the default member by adding the line Attribute Value.VB_UserMemId = 0 in a text editor after exporting the class module. (After you import it again, the line will not be visible, but it still takes effect.)

My super simple example "Test" class:

Private arr(1 To 3) As String

Private Sub Class_Initialize()
    arr(1) = "One"
    arr(2) = "Two"
    arr(3) = "Three"
End Sub

Public Function value(i As Integer) As String
    Attribute Value.VB_UserMemId = 0
    value = arr(i)
End Function

It can then be used as follows:

Sub Testing()
    Dim a As Test
    Set a = New Test
    Debug.Print a.value(2)
    Debug.Print a(3)
End Sub

And it will return "Two" for a.value(2) as per current approach and "Three" for a(3) as desired.

For more info on setting the default Class member, see Chip Pearson's site: http://www.cpearson.com/excel/DefaultMember.aspx

Introduction

If you are working with classes in VBA (see Class Modules for more details) it is often useful to make one member of a class the default member. For example, in the Excel Range object, the default member is Value. This allows you to omit the member name and use code like the following:

Range("A1") = 1234 ' is the same as
Range("A1").Value = 1234

Because Value is the default member, it may be omitted in the code. Creating a default member of a class is also very useful (necessary, really) when you are working with a customized Collection class. (See Creating A Custom Collection Class for more information about custom Collection classes.) In this case, you would likely specify the Item method as the default member. This allows you to use code like the following:

V = Coll(2)
' is the same as
V = Coll.Item(2)

Creating A Default Member In VBA

VBA does not directly support the creation of a default member of a class. That is, there is nothing in the VBA IDE that allows you to specify a default member. However, VBA does respect the default method if it is specified in a class. To specify a method as the default member, you need to Export the class module to a text file, edit that text file in NotePad or your favorite text editor, add an Attribute directive to the method, and then Import the text file back into the VBA Project.

First, export the class module to a text file. In VBA, go to the File menu and choose Export File.... In the Save dialog that appears, navigate to some folder (it doesn't matter which folder), and save the class file as text with a cls extension. Next, select Remove... from the File menu and choose No in the Do you want to export? dialog. Next, open Notepad ( C:\Windows\Notepad.exe) or another text editor, and open the cls that you saved in the Export step. In the text file, go to the method that you want to make the default, and add the following line of code.

Attribute Value.VB_UserMemId = 0

An Attribute directive is an instruction to the compiler indicating various conditions for compilation. The Attribute directives are not visible in the VBA Editor and they cannot be added by the VBA Editor. You must use a text editor to add Attribute directives. If you are making the Value property the default member of your class, your code in Notepad should look similar to the following:

Property Get Value() As Long
    Attribute Value.VB_UserMemId = 0
    Value = Whatever
End Property

You can make a Sub, Function, or Property the default member of the class, but only one procedure in the module may be the default member. Once you have added the Attribute directive to the text file, save the file and exit from NotePad. Now, in the VBA Editor, go to the File menu and choose Import File.... In the Open dialog that appears, navigate to the folder in which you saved the cls file and import it into VBA. Because Attribute directives are not visible in the VBA Editor, you will not see any changes in your code.

Once the Attribute directive is in place, you can use code like the following:

Dim CC As CMyClassName
Set CC = New CMyClassName
CC.Value = 123
' is the same as 
CC = 123

Answer 2

Hmm, maybe ... in VB6, there's an addon called 'Class generator'. It let's you mark a property as 'Default'. Doing so with your class and opening the saved *.cls file in a text editor reveals that VB6 simply adds a line to the property, e.g.

Viewing VB6 code editor:

Property Get coll() As Collection
    Set coll = zCollection
End Property

Viewing in any text editor:

Property Get coll() As Collection
Attribute coll.VB_UserMemId = 0
    Set coll = zCollection
End Property

And Excel allows to import files. Adn Excel didn't complain when importing the below *.cls file.

The following code then works in VB6:

Dim custColl As New MyCollection

With custColl
   .Add 11
   .Add 22
End With

Debug.Print custColl(1)   ' Prints '11'
Debug.Print custColl(2)   ' Prints '22'

Here's the whole class (sans non-defined parts such as your error handling method):

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "MyCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Private Const modName = "CollectionClass"

Private zCollection As New Collection

Property Get coll() As Collection
Attribute coll.VB_UserMemId = 0
    Set coll = zCollection
End Property

Public Function Count() As Variant

10      On Error GoTo SUB_ERR

20      Count = zCollection.Count

SUB_EXIT:
30      Exit Function

SUB_ERR:

End Function

Public Sub Add(var As Variant)

10      On Error GoTo SUB_ERR

20      zCollection.Add var

SUB_EXIT:
30      Exit Sub

SUB_ERR:

End Sub

Public Sub Remove(loc As Long)

10      On Error GoTo SUB_ERR

20      zCollection.Remove loc

SUB_EXIT:
30      Exit Sub

SUB_ERR:

End Sub

Public Sub RemoveObj(var As Variant)

10      On Error GoTo SUB_ERR

20      Dim i As Long

30      If IsMissing(var) Then
40          Dim xxx As Integer: xxx = 1000000 'Errors if no var sent
50      Else
60          Select Case TypeName(var)
                Case "PartClass"
70                  Dim part As Object
80                  i = 1
90                  For Each part In zCollection
100                     If part Is var Then
110                         Me.Remove i
120                         Exit Sub
130                     End If
140                     i = i + 1
150                 Next
160             Case Else
170                 xxx = 1000000 'Errors if unknown Type Name
180         End Select
190     End If

SUB_EXIT:
200     Exit Sub

SUB_ERR:

End Sub

Public Function Contains(var As Variant) As Boolean

10      On Error GoTo FUNC_ERR

30      If IsMissing(var) Then
40          Dim xxx As Integer: xxx = 1000000 'Errors if no var sent
50      Else
60          Select Case TypeName(var)
                Case "PartClass"
70                  Dim part As Object
90                  For Each part In zCollection
100                     If part Is var Then
110                         Contains = True
120                         Exit Function
130                     End If
150                 Next
160             Case Else
170                 xxx = 1000000 'Errors if unknown Type Name
180         End Select
190     End If

FUNC_EXIT:
200     Exit Function

FUNC_ERR:

End Function

I'm not familiar enough with Excel's VB editor to make a quick test, though

Answer 3

Not possible, because custColl(2) could only be used to reference the 2nd custom collection in an array of custom collections.