C# like List<T> in VBA
Generics appeared in C# 2.0; in VB6/VBA the closest you get is a Collection
. Lets you Add
, Remove
and Count
, but you'll need to wrap it with your own class if you want more functionality, such as AddRange
, Clear
and Contains
.
Collection
takes any Variant
(i.e. anything you throw at it), so you'll have to enforce the <T>
by verifying the type of the item(s) being added. The TypeName()
function would probably be useful for this.
I took the challenge :)
Updated see original code here
List.cls
Add a new class module to your VB6/VBA project. This will define the functionality of List<T>
we're implementing. As [Santosh]'s answer shows we're a little bit restricted in our selection of what collection structure we're going to wrap. We could do with arrays, but collections being objects make a better candidate, since we want an enumerator to use our List
in a For Each
construct.
Type Safety
The thing with List<T>
is that T
says this list is a list of what type exactly, and the constraint implies once we determine the type of T
, that list instance sticks to it. In VB6 we can use TypeName
to get a string representing the name of the type we're dealing with, so my approach would be to make the list know the name of the type it's holding at the very moment the first item is added: what C# does declaratively in VB6 we can implement as a runtime thing. But this is VB6, so let's not go crazy about preserving type safety of numeric value types - I mean we can be smarter than VB6 here all we want, at the end of the day it's not C# code; the language isn't very stiff about it, so a compromise could be to only allow implicit type conversion on numeric types of a smaller size than that of the first item in the list.
Private Type tList Encapsulated As Collection ItemTypeName As StringEnd TypePrivate this As tListOption ExplicitPrivate Function IsReferenceType() As Boolean If this.Encapsulated.Count = 0 Then IsReferenceType = False: Exit Function IsReferenceType = IsObject(this.Encapsulated(1))End FunctionPublic Property Get NewEnum() As IUnknown Attribute NewEnum.VB_Description = "Gets the enumerator from encapsulated collection." Attribute NewEnum.VB_UserMemId = -4 Attribute NewEnum.VB_MemberFlags = "40" Set NewEnum = this.Encapsulated.[_NewEnum]End PropertyPrivate Sub Class_Initialize() Set this.Encapsulated = New CollectionEnd SubPrivate Sub Class_Terminate() Set this.Encapsulated = NothingEnd Sub
Verifying if the value is of the appropriate type can be the role of a function that can be made public
for convenience, so a value can be tested to be valid by client code, before it's actually added. Every time we initialize a New List
, this.ItemTypeName
is an empty string for that instance; the rest of the time we're probably going to see the correct type, so let's not bother checking all possibilities (not C#, evaluation won't break at the first Or
that follows a true
statement):
Public Function IsTypeSafe(value As Variant) As Boolean Dim result As Boolean result = this.ItemTypeName = vbNullString Or this.ItemTypeName = TypeName(value) If result Then GoTo QuickExit result = result _ Or this.ItemTypeName = "Integer" And StringMatchesAny(TypeName(value), "Byte") _ Or this.ItemTypeName = "Long" And StringMatchesAny(TypeName(value), "Integer", "Byte") _ Or this.ItemTypeName = "Single" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte") _ Or this.ItemTypeName = "Double" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single") _ Or this.ItemTypeName = "Currency" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single", "Double")QuickExit: IsTypeSafe = resultEnd Function
Now that's a start.
So we have a Collection
. That buys us Count
, Add
, Remove
, and Item
. Now the latter is interesting, because it's also the Collection
's default property, and in C# it would be called an indexer property. In VB6 we set the Item.VB_UserMemId
attribute to 0 and we get a default property:
Public Property Get Item(ByVal index As Long) As Variant Attribute Item.VB_Description = "Gets/sets the item at the specified index." Attribute Item.VB_UserMemId = 0 If IsReferenceType Then Set Item = this.Encapsulated(index) Else Item = this.Encapsulated(index) End IfEnd Property
Procedure Attributes
In VBA the IDE does not provide any way of editing those, but you can edit the code in Notepad and import the edited .cls file into your VBA project. In VB6 you have a Tools menu to edit those:
Attribute NewEnum.VB_UserMemId = -4
tells VB to use this property to provide an enumerator - we're just passing it that of the encapsulated Collection
, and it being a hidden property it begins with an underscore (don't try this at home!). Attribute NewEnum.VB_MemberFlags = "40"
is supposed to make it a hidden property as well, but I haven't yet figured out why VB won't pick up on that one. So in order to call the getter for that hidden property, we need to surround it with []
square brackets, because an identifier can't legally start with an underscore in VB6/VBA.
One nice thing about the
NewEnum.VB_Description
attribute is that whatever description you enter there, shows up in the Object Browser (F2) as a description/mini-documentation for your code.
Item Accessors / "Setters"
The VB6/VBA Collection
doesn't allow directly writing values into its items. We can assign references, but not values. We can implement a write-enabled List
by providing setters for the Item
property - because we don't know if our T
will be a value or a reference/object, we'll provide both Let
and Set
accessors. Since Collection
doesn't support this we're going to have to first remove the item at the specified index, and then insert the new value at that place.
Good news, RemoveAt
and Insert
are two methods we're going to have to implement anyway, and RemoveAt
comes for free because its semantics are the same as those of the encapsulated Collection
:
Public Sub RemoveAt(ByVal index As Long) this.Encapsulated.Remove indexEnd SubPublic Sub RemoveRange(ByVal Index As Long, ByVal valuesCount As Long) Dim i As Long For i = Index To Index + valuesCount - 1 RemoveAt Index NextEnd Sub
My implementation of Insert
feels like it could get much better, but it essentially reads as "grab everything after the specified index, make a copy; remove everything after the specified index; add the specified value, add back the rest of the items":
Public Sub Insert(ByVal index As Long, ByVal value As Variant) Dim i As Long, isObjRef As Boolean Dim tmp As New List If index > Count Then Err.Raise 9 'index out of range For i = index To Count tmp.Add Item(i) Next For i = index To Count RemoveAt index Next Add value Append tmpEnd Sub
InsertRange
can take a ParamArray
so we can supply inline values:
Public Sub InsertRange(ByVal Index As Long, ParamArray values()) Dim i As Long, isObjRef As Boolean Dim tmp As New List If Index > Count Then Err.Raise 9 'index out of range For i = Index To Count tmp.Add Item(i) Next For i = Index To Count RemoveAt Index Next For i = LBound(values) To UBound(values) Add values(i) Next Append tmpEnd Sub
Reverse
has nothing to do with sorting, so we can implement it right away:
Public Sub Reverse() Dim i As Long, tmp As New List Do Until Count = 0 tmp.Add Item(Count) RemoveAt Count Loop Append tmpEnd Sub
Here I thought, since VB6 doesn't support overloads. that it would be nice to have a method that can add all items from another list, so I called that Append
:
Public Sub Append(ByRef values As List) Dim value As Variant, i As Long For i = 1 To values.Count Add values(i) NextEnd Sub
Add
is where our List
becomes more than just an encapsulated Collection
with a couple extra methods: if it's the first item being added to the list, we have a piece of logic to execute here - not that I don't care about how many items there are in the encapsulated collection, so if all items are removed from the list the type of T
remains constrained:
Public Sub Add(ByVal value As Variant) If this.ItemTypeName = vbNullString Then this.ItemTypeName = TypeName(value) If Not IsTypeSafe(value) Then Err.Raise 13, ToString, "Type Mismatch. Expected: '" & this.ItemTypeName & "'; '" & TypeName(value) & "' was supplied." 'Type Mismatch this.Encapsulated.Add valueEnd Sub
The source of the error raised when Add
fails is the result of a call to ToString
, a method that returns... the name of the type, including the type of T - so we can make it a List<T>
instead of a List(Of T)
:
Public Function ToString() As String ToString = TypeName(Me) & "<" & Coalesce(this.ItemTypeName, "Variant") & ">"End Function
List<T>
allows adding many items at once. At first I implemented AddRange
with an array of values for a parameter, but then with usage it occurred to me that again, this isn't C#, and taking in a ParamArray
is much, much more handy:
Public Sub AddRange(ParamArray values()) Dim value As Variant, i As Long For i = LBound(values) To UBound(values) Add values(i) NextEnd Sub
...And then we get to those Item
setters:
Public Property Let Item(ByVal index As Long, ByVal value As Variant) RemoveAt index Insert index, valueEnd PropertyPublic Property Set Item(ByVal index As Long, ByVal value As Variant) RemoveAt index Insert index, valueEnd Property
Removing an item by providing a value instead of an index, would require another method that gives us the index of that value, and because we're not only supporting value types but also reference types, this is going to be very fun, because now we need a way to determine equality between reference types - we can get reference equality by comparing ObjPtr(value)
, but we're going to need more than just that - the .net framework taught me about IComparable
and IEquatable
. Let's just cram these two interfaces into one and call it IComparable
- yes, you can write and implement interfaces in VB6/VBA.
IComparable.cls
Add a new class module and call it IComparable
- if you really plan to use them for something else then you could put them in two separate class modules and call the other one IEquatable
, but that would make you two interfaces to implement instead of one, for all reference types you want to be able to work with.
This isn't mock-up code, all that's needed is the method signatures:
Option ExplicitPublic Function CompareTo(other As Variant) As Integer'Compares this instance with another; returns one of the following values:' -1 if [other] is smaller than this instance.' 1 if [other] is greater than this instance.' 0 otherwise.End FunctionPublic Function Equals(other As Variant) As Boolean'Compares this instance with another; returns true if the two instances are equal.End Function
List.cls
Putting the IComparable interface to use
Given that we have packed our IComparable
with CompareTo
and Equals
, we can now find the index of any value in our list; we can also determine if the list contains any specified value:
Public Function IndexOf(value As Variant) As Long Dim i As Long, isRef As Boolean, comparable As IComparable isRef = IsReferenceType For i = 1 To this.Encapsulated.Count If isRef Then If TypeOf this.Encapsulated(i) Is IComparable And TypeOf value Is IComparable Then Set comparable = this.Encapsulated(i) If comparable.Equals(value) Then IndexOf = i Exit Function End If Else 'reference type isn't comparable: use reference equality If ObjPtr(this.Encapsulated(i)) = ObjPtr(value) Then IndexOf = i Exit Function End If End If Else If this.Encapsulated(i) = value Then IndexOf = i Exit Function End If End If Next IndexOf = -1End FunctionPublic Function Contains(value As Variant) As Boolean Dim v As Variant, isRef As Boolean, comparable As IComparable isRef = IsReferenceType For Each v In this.Encapsulated If isRef Then If TypeOf v Is IComparable And TypeOf value Is IComparable Then Set comparable = v If comparable.Equals(value) Then Contains = True: Exit Function Else 'reference type isn't comparable: use reference equality If ObjPtr(v) = ObjPtr(value) Then Contains = True: Exit Function End If Else If v = value Then Contains = True: Exit Function End If NextEnd Function
The CompareTo
method comes into play when we start asking what the Min
and Max
values might be:
Public Function Min() As Variant Dim i As Long, isRef As Boolean Dim smallest As Variant, isSmaller As Boolean, comparable As IComparable isRef = IsReferenceType For i = 1 To Count If isRef And IsEmpty(smallest) Then Set smallest = Item(i) ElseIf IsEmpty(smallest) Then smallest = Item(i) End If If TypeOf Item(i) Is IComparable Then Set comparable = Item(i) isSmaller = comparable.CompareTo(smallest) < 0 Else isSmaller = Item(i) < smallest End If If isSmaller Then If isRef Then Set smallest = Item(i) Else smallest = Item(i) End If End If Next If isRef Then Set Min = smallest Else Min = smallest End IfEnd FunctionPublic Function Max() As Variant Dim i As Long, isRef As Boolean Dim largest As Variant, isLarger As Boolean, comparable As IComparable isRef = IsReferenceType For i = 1 To Count If isRef And IsEmpty(largest) Then Set largest = Item(i) ElseIf IsEmpty(largest) Then largest = Item(i) End If If TypeOf Item(i) Is IComparable Then Set comparable = Item(i) isLarger = comparable.CompareTo(largest) > 0 Else isLarger = Item(i) > largest End If If isLarger Then If isRef Then Set largest = Item(i) Else largest = Item(i) End If End If Next If isRef Then Set Max = largest Else Max = largest End IfEnd Function
These two functions allow a very readable sorting - because of what's going on here (adding & removing items), we're going to have to fail fast:
Public Sub Sort() If Not IsNumeric(First) And Not this.ItemTypeName = "String" And Not TypeOf First Is IComparer Then Err.Raise 5, ToString, "Invalid operation: Sort() requires a list of numeric or string values, or a list of objects implementing the IComparer interface." Dim i As Long, value As Variant, tmp As New List, minValue As Variant, isRef As Boolean isRef = IsReferenceType Do Until Count = 0 If isRef Then Set minValue = Min Else minValue = Min End If tmp.Add minValue RemoveAt IndexOf(minValue) Loop Append tmpEnd SubPublic Sub SortDescending() If Not IsNumeric(First) And Not this.ItemTypeName = "String" And Not TypeOf First Is IComparer Then Err.Raise 5, ToString, "Invalid operation: SortDescending() requires a list of numeric or string values, or a list of objects implementing the IComparer interface." Dim i As Long, value As Variant, tmp As New List, maxValue As Variant, isRef As Boolean isRef = IsReferenceType Do Until Count = 0 If isRef Then Set maxValue = Max Else maxValue = Max End If tmp.Add maxValue RemoveAt IndexOf(maxValue) Loop Append tmpEnd Sub
The final touch
The rest is just trivial stuff:
Public Sub Remove(value As Variant) Dim index As Long index = IndexOf(value) If index <> -1 Then this.Encapsulated.Remove indexEnd SubPublic Property Get Count() As Long Count = this.Encapsulated.CountEnd PropertyPublic Sub Clear() Do Until Count = 0 this.Encapsulated.Remove 1 LoopEnd SubPublic Function First() As Variant If Count = 0 Then Exit Function If IsObject(Item(1)) Then Set First = Item(1) Else First = Item(1) End IfEnd FunctionPublic Function Last() As Variant If Count = 0 Then Exit Function If IsObject(Item(Count)) Then Set Last = Item(Count) Else Last = Item(Count) End IfEnd Function
One fun thing about List<T>
is that it can be copied into an array just by calling ToArray()
on it - we can do exactly that:
Public Function ToArray() As Variant() Dim result() As Variant ReDim result(1 To Count) Dim i As Long If Count = 0 Then Exit Function If IsReferenceType Then For i = 1 To Count Set result(i) = this.Encapsulated(i) Next Else For i = 1 To Count result(i) = this.Encapsulated(i) Next End If ToArray = resultEnd Function
That's all!
I'm using a few helper functions, here they are - they probably belong in some StringHelpers
code module:
Public Function StringMatchesAny(ByVal string_source As String, find_strings() As Variant) As Boolean Dim find As String, i As Integer, found As Boolean For i = LBound(find_strings) To UBound(find_strings) find = CStr(find_strings(i)) found = (string_source = find) If found Then Exit For Next StringMatchesAny = foundEnd FunctionPublic Function Coalesce(ByVal value As Variant, Optional ByVal value_when_null As Variant = 0) As Variant Dim return_value As Variant On Error Resume Next 'supress error handling If IsNull(value) Or (TypeName(value) = "String" And value = vbNullString) Then return_value = value_when_null Else return_value = value End If Err.Clear 'clear any errors that might have occurred On Error GoTo 0 'reinstate error handling Coalesce = return_valueEnd Function
MyClass.cls
This implementation requires, when T
is a reference type / object, that the class implements the IComparable
interface in order to be sortable and for finding the index of a value. Here's how it's done - say you have a class called MyClass
with a numeric or String
property called SomeProperty
:
Implements IComparableOption ExplicitPrivate Function IComparable_CompareTo(other As Variant) As Integer Dim comparable As MyClass If Not TypeOf other Is MyClass Then Err.Raise 5 Set comparable = other If comparable Is Nothing Then IComparable_CompareTo = 1: Exit Function If Me.SomeProperty < comparable.SomeProperty Then IComparable_CompareTo = -1 ElseIf Me.SomeProperty > comparable.SomeProperty Then IComparable_CompareTo = 1 End IfEnd FunctionPrivate Function IComparable_Equals(other As Variant) As Boolean Dim comparable As MyClass If Not TypeOf other Is MyClass Then Err.Raise 5 Set comparable = other IComparable_Equals = comparable.SomeProperty = Me.SomePropertyEnd Function
The List
can be used like this:
Dim myList As New ListmyList.AddRange 1, 12, 123, 1234, 12345 ', 123456 would blow up because it's a LongmyList.SortDescendingDim value As VariantFor Each value In myList Debug.Print ValueNextDebug.Print myList.IndexOf(123) 'prints 3Debug.Print myList.ToString & ".IsTypeSafe(""abc""): " & myList.IsTypeSafe("abc") ' prints List<Integer>.IsTypeSafe("abc"): false
I know this is an old post, but I'd like to mention the following in addition to what's been discussed...
Array Lists
You can use an ArrayList, which is a weakly typed (uses objects, not strongly typed) linked list available in VBA. Here's some sample code demonstrating basic usage.
Sub ArrayListDemo() Dim MyArray(1 To 7) As String MyArray(1) = "A" MyArray(2) = "B" MyArray(3) = "B" MyArray(4) = "i" MyArray(5) = "x" MyArray(6) = "B" MyArray(7) = "C" Set L1 = ToList(MyArray) L1.Insert L1.LastIndexOf("B"), "Zz" Set L2 = L1.Clone L2.Sort L2.Reverse L2.Insert 0, "----------------" L2.Insert 0, "Sort and Reverse" L2.Insert 0, "----------------" L1.AddRange L2.Clone Set L3 = SnipArray(L1, 9, 3) Debug.Print "---- L1 Values ----" For Each obj In L1 Debug.Print obj & " (L1 & L3 = " & L3.Contains(obj) & ")" Next Debug.Print "---- L3 Values ----" For Each obj In L3 Debug.Print obj NextEnd SubFunction ToList(ByVal Arr As Variant) As Object Set ToList = CreateObject("System.Collections.ArrayList") For Each Elm In Arr ToList.Add Elm Next ElmEnd FunctionFunction SnipArray(ByVal ArrayList As Object, lower As Integer, length As Integer) As Object Set SnipArray = ArrayList.Clone lower = lower - 1 upper = lower + length If upper < ArrayList.Count Then SnipArray.RemoveRange upper, (ArrayList.Count - upper) End If If lower > 0 Then SnipArray.RemoveRange 0, lower End IfEnd Function
Dictionary
Also, glad to see dictionary was mentioned. Here are a couple notes about how to use a dictionary in VBA and use it like a list:
Sub DictionaryDemo() 'If you have a reference to "Microsoft Scripting Runtime..."' Set D = New Dictionary 'Else use this if you do not want to bother with adding a reference' Set D = CreateObject("Scripting.Dictionary") 'You can structure a dictionary as a zero based array like this' D.Add D.Count, "A" Debug.Print D(0) Set D = NothingEnd Sub
List<T>
are index based collection which allows to attach any datatype to collection object which is not possible in VBA.
Index based Collection for VBA
Key-Value pair Collection for VBA
Alternatively you may create a class library in C# and consume in VBA. Refer this link