14
\$\begingroup\$

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
\$\endgroup\$
  • 3
    \$\begingroup\$ god I wish every question on SE is laid out like yours! ++ \$\endgroup\$ – user28366 Aug 21 '14 at 21:41
  • \$\begingroup\$ 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. \$\endgroup\$ – user109261 Oct 29 '17 at 0:21
10
\$\begingroup\$

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.
\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – RubberDuck Aug 21 '14 at 2:38
  • \$\begingroup\$ 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. \$\endgroup\$ – RubberDuck Aug 21 '14 at 2:40
7
\$\begingroup\$

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

\$\endgroup\$
7
\$\begingroup\$

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.

\$\endgroup\$
  • 1
    \$\begingroup\$ 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. \$\endgroup\$ – RubberDuck Oct 13 '14 at 17:51
  • \$\begingroup\$ so was I when I did .Remove 999 but it's the same on a native Collection object \$\endgroup\$ – user28366 Oct 13 '14 at 18:18

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.