Building a better Collection. Enumerable in VBA

Question

VBA's 'Collection' is.... lacking, so, I've been working on a better Collection object that implements many of the features of C#'s Enumerable. This is very much inspired by this question and a follow up to Sorting a Collection and More imitation of Enumerable.

I'm concerned that the API is inconsistent. Some methods like Range and Repeat are meant to be called from a "static" default global instance, while others are to be called on instanced.. instances of 'Enumerable'. I started out writing everything to be static, but the calls felt weird. To clarify, it's the difference between this

Dim c as New Enumerable
Set c = Enumerable.Intersect(collection1,collection2)

and

Set c = collection1.Intersect(collection2)

I opted for the latter wherever it made sense to, (made sense to me) but it makes things inconsistent, because of calls like this.

For each char in Enumerable.Repeat("A",3)
 debug.print char
next
For each number in Enumerable.Range(1,10)
 debug.print "Hello World"
next 

This is also a fairly large chunk of code, so I'm interested on how I can better group and organize the code.

Download Available From Google Drive.

Header

VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "Enumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

---

Declarations

Option Explicit
Public Enum EnumerableError
 vbMethodNotSupportedError = 438
 EnumerableNotIntializedError = vbObjectError + 6500
 EnumerableInvalidArgumentError
End Enum
Private Const NotInitializedErrorMessage As String = "Collection Property Not Set"
Private Const InvalidArgumentErrorMessage As String = "Invalid Argument."
Private mCollection As Collection
Private mIsSorted As Boolean

---

Properties

Public Property Set Collection(obj As Variant)
 If TypeName(obj) = "Collection" Then
 Set mCollection = obj
 ElseIf TypeName(obj) = "Enumerable" Then
 Set mCollection = obj.Collection
 Else
 Set mCollection = New Collection
 Merge obj
 End If
End Property
Public Function Merge(collectionObject As Variant)
' Tries to convert any object passed in to a collection.
' This allows collection *like* objects such as Worksheets and Ranges.
On Error GoTo ErrHandler
 Dim element As Variant
 For Each element In collectionObject
 mCollection.Add element
 Next
Exit Function
ErrHandler:
 Const ObjectNotEnumerableMessage As String = "Object is not Enumerable."
 
 If Err.number = vbMethodNotSupportedError Then
 Err.Raise Err.number, TypeName(Me), InvalidArgumentErrorMessage & " " & ObjectNotEnumerableMessage, Err.HelpFile, Err.HelpContext
 Else
 ReRaiseError Err
 End If
End Function
Public Property Get Collection() As Collection
 Set Collection = mCollection
End Property
Public Property Get IsSorted() As Boolean
 IsSorted = mIsSorted
End Property
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
 Set NewEnum = mCollection.[_NewEnum]
End Property

---

Collection Wrappers

' Collection Wrappers
Public Sub Add(item, Optional Key, Optional Before, Optional After)
 mCollection.Add item, Key, Before, After
End Sub
Public Sub Remove(index)
 mCollection.Remove index
End Sub
Public Function Count()
 Count = mCollection.Count
End Function
Public Function item(Optional index)
Attribute item.VB_UserMemId = 0
 item = mCollection.item(index)
End Function

---

"Static" Functions

' "Static" functions to be used with default instance of Enumerable
Public Function Range(ByVal startValue As Long, ByVal endValue As Long) As Enumerable 'Collection
 
 Set mCollection = New Collection
 
 Dim i As Long
 For i = startValue To endValue
 mCollection.Add i
 Next
 
 Set Range = New Enumerable
 Set Range.Collection = mCollection
End Function
Public Function Repeat(ByVal value, ByVal times As Long) As Enumerable
 Set mCollection = New Collection
 
 Dim i As Long
 For i = 1 To times
 mCollection.Add value
 Next
 
 Set Repeat = New Enumerable
 Set Repeat.Collection = mCollection
End Function

---

Instance Methods

' All of these functions work only on Collections whose items have a default value.
' If the items do not have a default value,
' Runtime Error 438 "Object doesn't support this property or method" is raised.
' Instance Methods
Public Function Contains(itemToSearchFor As Variant, Optional ByVal compareByDefaultProperty = False) As Boolean
Attribute Contains.VB_Description = "Checks if an item exists in a Collection. Matches on the Default Property by Default. Runtime Error 438 'Object does not support method' may be raised when using 'compareByDefaultProperty'."
On Error GoTo ErrHandler
 Dim item As Variant
 
 'compareByDefaultProperty is an unsafe option
 For Each item In mCollection
 If IsObject(item) And Not compareByDefaultProperty Then
 If item Is itemToSearchFor Then
 Contains = True
 Exit Function
 End If
 Else
 If item = itemToSearchFor Then
 Contains = True
 Exit Function
 End If
 End If
 Next item
 
 
ExitFunction:
 Contains = False
 Exit Function
ErrHandler:
 HandleComparisonError Err
 Resume ExitFunction
End Function
Public Function First() As Variant
 First = mCollection(1)
End Function
Public Function Last() As Variant
 Last = mCollection(mCollection.Count)
End Function
Public Function Min() As Variant
On Error GoTo ErrHandler
 If mIsSorted Then
 Min = First
 Else
 Dim item As Variant
 Dim result As Variant
 
 For Each item In mCollection
 If IsEmpty(result) Then
 result = item
 Else
 If item < result Then
 result = item
 End If
 End If
 Next item
 
 Min = result
 End If
ExitFunction:
 Exit Function
ErrHandler:
 HandleComparisonError Err
End Function
Public Function Max() As Variant
On Error GoTo ErrHandler
 
 If mIsSorted Then
 Max = Last
 Else
 Dim item As Variant
 Dim result As Variant
 
 For Each item In mCollection
 If IsEmpty(result) Then
 result = item
 Else
 If item > result Then
 result = item
 End If
 End If
 Next item
 
 Max = result
 End If
 
ExitFunction:
 Exit Function
ErrHandler:
 HandleComparisonError Err
End Function
Public Function Intersect(collection2 As Enumerable) As Enumerable 'Collection
 On Error GoTo ErrHandler
 
 If collection2 Is Nothing Then
 Err.Raise EnumerableInvalidArgumentError, TypeName(Me), InvalidArgumentErrorMessage
 End If
 
 Dim results As Enumerable
 Set results = New Enumerable
 Dim item As Variant
 Dim innerItem As Variant
 
 For Each item In mCollection
 For Each innerItem In collection2
 If item = innerItem And Not IsEmpty(item) Then
 If Not results.Contains(innerItem) Then 'curse the lack of shortcircuiting
 results.Add innerItem
 Exit For
 End If
 End If
 Next innerItem
 Next item
 
 Set Intersect = results
 
ExitFunction:
 Exit Function
ErrHandler:
 HandleComparisonError Err
End Function
Public Function Distinct() As Enumerable
 Set Distinct = New Enumerable
 Set Distinct = Me.Intersect(Me)
End Function
Public Function Clone() As Enumerable
 Set Clone = New Enumerable
 Set Clone.Collection = CloneCollection
End Function
Public Function CloneCollection() As Collection
 Dim element As Variant
 Dim results As New Collection
 
 For Each element In mCollection
 results.Add item
 Next
 
 Set CloneCollection = results
End Function
Public Function ToArray() As Variant
 Dim arr() As Variant
 ReDim arr(mCollection.Count - 1)
 Dim element As Variant
 
 Dim i As Long: i = 0
 For Each element In mCollection
 arr(i) = element
 i = i + 1
 Next
 
 ToArray = arr
End Function
Public Sub Sort()
' implements a bubble sort
On Error GoTo ErrHandler
 
 Dim i As Long
 Dim j As Long
 Dim hasSwapped As Boolean
 Dim collectionCount As Long: collectionCount = mCollection.Count
 
 For i = collectionCount To 2 Step -1
 hasSwapped = False
 
 For j = 1 To i - 1
 If mCollection(j) > mCollection(j + 1) Then
 mCollection.Add mCollection(j), After:=j + 1
 mCollection.Remove j
 hasSwapped = True
 End If
 Next j
 If Not hasSwapped Then Exit For
 Next i
 
 mIsSorted = True
 
ExitFunction:
 Exit Sub
 
ErrHandler:
 mIsSorted = False
 HandleComparisonError Err
 
End Sub

---

Private Helper Subs/Functions

Private Sub AssignUnknown(ByRef destination As Variant, ByRef source As Variant)
 If IsObject(source) Then
 Set destination = source
 Else
 destination = source
 End If
End Sub
Private Sub HandleComparisonError(error As ErrObject)
 Const ComparisonNotSupportedMessage As String = "An item in the collection does not have a default property; Cannot compare items without a default property."
 If error.number = vbMethodNotSupportedError Then
 error.Raise error.number, TypeName(Me), ComparisonNotSupportedMessage, error.HelpFile, error.HelpContext
 Else
 ReRaiseError error
 End If
 
End Sub
Private Sub ReRaiseError(error As ErrObject)
 error.Raise error.number, error.source, error.Description, error.HelpFile, error.HelpContext
End Sub
Private Sub Class_Initialize()
 Set mCollection = New Collection
End Sub

• user28366: god I wish every question on SE is laid out like yours! ++
• user109261: I used code snippets from you post in Passing Functions into a Custom VB Class. In my post I use Application.Run to pass custom functions into my SortableCollections Class. I think that it would be a good addition to your Collection Wrapper Class.

Answer 1

Design

I think you need to break that class in two. Having instance members on a static class is pretty confusing and bug-prone.

I'd suggest Enumerable to be the static class, with these members (notice source being preferred over collectionObject, and explicit ByRef modifiers and Variant types):

• Function Contains(ByRef source As Variant, ByVal value As Variant, Optional ByVal compareDefaultProperty As Boolean = False) As Boolean
• Function First(ByRef source As Variant) As Variant
• Function Last(ByRef source As Variant) As Variant
• Function Intersect(ByRef source1 As Variant, ByRef source2 As Variant) As Iteratable
• Function Distinct(ByRef source As Variant) As Iteratable
• Function Clone(ByRef source As Variant) As Iteratable
• Function ToArray(ByRef source As Variant) As Variant

Then, you can implement an Iteratable class with a NewEnum property; the beauty is that the instance variants of the static functions, can simply call on the static versions:

Public Function Contains(ByVal value as Variant, Optional ByVal compareDefaultProperty As Boolean = False) As Boolean
 Contains = Enumerable.Contains(Me, value, compareDefaultProperty)
End Function
Public Function First() As Variant
 First = Enumerable.First(Me)
End Function
Public Function Last() As Variant
 Last = Enumerable.Last(Me)
End Function

And so on and so forth.

---

Potential Bugs

You're storing a Boolean that "remembers" whether the encapsulated collection is sorted:

Private mCollection As Collection
Private mIsSorted As Boolean

The problem is that...

Public Property Set Collection(obj As Variant)
 If TypeName(obj) = "Collection" Then
 Set mCollection = obj
 ElseIf TypeName(obj) = "Enumerable" Then
 Set mCollection = obj.Collection
 Else
 Set mCollection = New Collection
 Merge obj
 End If
End Property

...the flag is going to lie whenever the Collection property gets set. Simply setting mIsSorted = False in the property setter fixes that.

...but it's more complicated than that:

Public Function Merge(collectionObject As Variant)
' Tries to convert any object passed in to a collection.
' This allows collection *like* objects such as Worksheets and Ranges.
On Error GoTo ErrHandler
 Dim element As Variant
 For Each element In collectionObject
 mCollection.Add element
 Next
 'are we still sorted here?

and:

Public Sub Add(item, Optional Key, Optional Before, Optional After)
 mCollection.Add item, Key, Before, After
 'are we still sorted here?
End Sub

The static functions shouldn't tamper with the instance-level field:

Public Function Range(ByVal startValue As Long, ByVal endValue As Long) As Enumerable 'Collection
 Set mCollection = New Collection
 '...
 Set Range.Collection = mCollection

That should really be a local Collection reference.

Moreover, this code is legal:

Enumerable.Sort

Granted, it's a misuse of the class, but nothing forbids doing this:

Set Enumerable.Collection = New Collection

And abusing the default instance - that's where IsSorted will tell the biggest lies, and break Min and Max implementations.

Splitting the class into a static Enumerable class and a non-static Iteratable class addresses this issue, since the static Enumerable class has no reason to encapsulate an instance-level collection.

---

Range should raise an error whenever startValue is greater than endValue.

---

Miscellaneous

• AssignUnknown isn't used anywhere, I'd remove it.
• Sort, Min and Max don't make sense on a Collection - it's permitted to compare apples with oranges and bananas. Sort / compare items of an Integer(), a String(), or a List, but not of a Collection.
• CloneCollection should be called ToCollection; its semantics are very similar to those of ToArray, naming should be just as similar.
• I'd remove the "Section" comments. 'Collection Wrappers isn't useful. Neither is 'Instance Methods. '"Static" functions to be used with default instance of Enumerable is a little better, but moot if the API gets fixed / split into static + instance API's.
• Merge should be a Sub. It being a Function that doesn't return anything is quite confusing.
• I like that Merge works with any array, Collection, or List (did you know that?).
• I'd add a Clear method, to remove all items at once.

• RubberDuck: Hmmm... I'm not sure about removing Clone. Client code was getting buggy passing around references. I'll have to think about that, but otherwise excellent advise. Definitely splitting this into two classes.
• RubberDuck: And yes. I was aware that Merge works with arrays, collections, and collection like objects (think Sheets.Range), but I didn't know it would work with your List class. I should really look at that code closer.

Answer 2

You have some nested if statements that I think you could un-nest a little bit

 For Each item In mCollection
 If IsEmpty(result) Then
 result = item
 Else
 If item < result Then
 result = item
 End If
 End If
 Next item

so like this instead

 For Each item In mCollection
 If IsEmpty(result) Then
 result = item
 Else If item < result Then
 result = item
 End If
 Next item

that will do the same thing with less nesting.

this can be done in both the Min and Max functions

Answer 3

On top what other experts have mentioned already I would like to suggest an idea;

Since you implementing wrapper functions you could also handle the really generic and ugly errors like

enter image description here

when a user was trying to

Enumerable.Remove 999

and 999 was an index out of bounds you could take a better care of that with some sort of error handler? Perhaps a MsgBox with an actual explanation on the reason why something is not possible instead of that ugly general invalid procedure call or argument?

Also:

In the static Range() you should at least check that the endValue > startValue, and Repeat() the times > 1

Also, I am not sure if that's a good practice or not but when I am doing a library with static functions I prefer to Dim i as Long only once as a private global and then don't have to worry to dim it each time I need to loop using an i iterator.

• RubberDuck: I'm a little surprised that raised an invalid procedure call instead of an index out of bounds. I'll definitely look at that. Thanks.
• user28366: so was I when I did .Remove 999 but it's the same on a native Collection object