I was inspired by Me How's question to see how far I could push an imitation of .Net's Enumerable Class.
The new functions can obviously handle Collections, but can also handle any collection-type object whose items have a default value. If a collectionObject
's items don't have a default value, Runtime Error 438 "Object does not support property or method" is raised. So, things like Cells
and Range
work, but Worksheets
doesn't.
Min
and Max
only differ by one operator, so there's some duplication there, but I don't know how to refactor it out. Intersect
also seems inefficient to me, but I couldn't imagine a better algorithm. So, those are particular areas of interest to me. Suggestions for which features to add next would also be appreciated.
Enumerable.cls
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
Private c As Collection ' used for Range
Public Function Range(ByVal startValue As Long, ByVal endValue As Long) As Collection
Attribute Range.VB_Description = "Returns a collection of longs."
Set c = New Collection
Dim i As Long
For i = startValue To endValue
c.Add i
Next
Set Range = c
End Function
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = c.[_NewEnum]
End Property
' All of these functions work only on collectionObjects 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.
Public Function Contains(collectionObject As Variant, itemToSearchFor As Variant) As Boolean
Attribute Contains.VB_Description = "Checks if an item exists in a Collection. Matches on the default property."
Dim item As Variant
For Each item In collectionObject
If item = itemToSearchFor Then
Contains = True
Exit Function
End If
Next item
Contains = False
End Function
Public Function Min(collectionObject As Variant) As Variant
Attribute Min.VB_Description = "Returns the item with the minimum value in a Collection. Uses the default property."
Dim item As Variant
Dim result As Variant
Dim isFirstTry As Boolean: isFirstTry = True
For Each item In collectionObject
If isFirstTry Then
result = item
isFirstTry = False
Else
If item < result Then
result = item
End If
End If
Next item
Min = result
End Function
Public Function Max(collectionObject As Variant) As Variant
Attribute Max.VB_Description = "Returns the item with the minimum value in a Collection. Uses the default property."
Dim item As Variant
Dim result As Variant
Dim isFirstTry As Boolean: isFirstTry = True
For Each item In collectionObject
If isFirstTry Then
result = item
isFirstTry = False
Else
If item > result Then
result = item
End If
End If
Next item
Max = result
End Function
Public Function Intersect(collection1 As Variant, collection2 As Variant) As Collection
Attribute Intersect.VB_Description = "Returns a new collection containing the items that are common to both collection parameters. Returns Nothing if either parameter IsNothing."
If collection1 Is Nothing Or collection2 Is Nothing Then
Exit Function
End If
Set Intersect = New Collection
Dim item As Variant
Dim innerItem As Variant
For Each item In collection1
For Each innerItem In collection2
If item = innerItem And Not IsEmpty(item) Then
Intersect.Add innerItem
End If
Next innerItem
Next item
End Function
For anyone interested, the reason you can call these functions without creating a new instance is setting VB_PredeclaredID = True
creates a default instance of the class.