To Collect or HashThe VBA.Collection has a number of limitations, but it is enumerable and you can refer to items by index or key. But the VBA implementation of a Collection is 1-based, and they don't have any way of confirming membership, and the Item method returns a Variant, so they're loosely typed. Did I say Item method? Yes, that's right, Item is a method. Let's make it a property while we're at it.Dictionaries aren't enumerable, but they have useful methods like Exists and RemoveAll. They're implemented as hash-tables behind the scenes, so they're faster than Collections for retrieving members and/or for confirming membership.What if I could combine the best features of Collections and Dictionaries?0 or 1 based (user configurable)Strongly typed Item methodItem method is default member, and it's a propertyExists method for membership checksEnumerableAdd a Widget to the collection without having to specify a keyAnd why not throw in a factory method too, although some might argue it's a return to the year 2000.In order to get the enumerable features of a Collection, I'll have to use a Collection behind the scenes, but I'll augment that with a Dictionary that keeps track of the keys used in the Collection. Then, when I want to test the Exists method, I can check the Dictionary (and get all of it's hash-tabled goodness) instead of enumerating the Collection or suppressing a potential error by checking the index/key directly.I also want to make the Collection configurable so that it can be 0 or 1 based according to preference. I've made this setting private to the Collection, so it's up to the developer to adjust for the purpose at hand, but it could easily be exposed as property or set in a factory method.Pass the WidgetFirst, we need a class for the objects that we'll put into our custom collection. A Widget will do nicely. Nothing special here - just a class with a few encapsulated fields, and a bonus read-only property for returning an instance of itself.VERSION 1.0 CLASSBEGIN  MultiUse = -1  'TrueENDAttribute VB_Name = WidgetAttribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalseAttribute VB_Description = The Widget is the core of our business.Option ExplicitPrivate Type TWidget  ID As String  Name As String  ReleaseDate As DateEnd TypePrivate this As TWidgetPublic Property Get ID() As StringAttribute ID.VB_Description = The unique identifier of the Widget  ID = this.IDEnd PropertyPublic Property Let ID(ByVal Value As String)  this.ID = ValueEnd PropertyPublic Property Get Name() As StringAttribute Name.VB_Description = The name of the Widget  Name = this.NameEnd PropertyPublic Property Let Name(ByVal Value As String)  this.Name = ValueEnd PropertyPublic Property Get ReleaseDate() As DateAttribute ReleaseDate.VB_Description = The release date of the Widget  ReleaseDate = this.ReleaseDateEnd PropertyPublic Property Let ReleaseDate(ByVal Value As Date)  this.ReleaseDate = ValueEnd PropertyPublic Property Get Self() As WidgetAttribute Self.VB_Description = Returns an instance of this Widget  Set Self = MeEnd PropertyCollect all the WidgetsThen we need a class to hold all of the widgets. The all important method for enumerating the collection is NewEnum which has a special attribute VB_UserMemId = -4 set. The class also has a factory method for creating a Widget (Without actually adding it to the collection).VERSION 1.0 CLASSBEGIN  MultiUse = -1  'TrueENDAttribute VB_Name = WidgetsAttribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalseAttribute VB_Description = A custom collection for enumerating Widgets.Option ExplicitPrivate Enum CollectionBase  Base0 = 0  Base1 = 1End EnumPrivate Const COLLECTION_BASE As Long = CollectionBase.Base0Private Type TWidgets  Collection As Collection  Keys As Scripting.DictionaryEnd TypePrivate this As TWidgetsPrivate Sub Class_Initialize()  Set this.Collection = New Collection  Set this.Keys = New Scripting.DictionaryEnd SubPublic Function NewEnum() As IUnknownAttribute NewEnum.VB_UserMemId = -4Attribute NewEnum.VB_Description = The magic enumerator method with UserMemId = -4.  Set NewEnum = this.Collection.[_NewEnum]End FunctionPublic Sub Add(ByRef Widget As Widget)Attribute Add.VB_Description = Adds a widget to the collection.  Dim Key As String  Key = Widget.ID  If Not this.Keys.Exists(Key) Then    this.Collection.Add Widget, Key    this.Keys.Add Key, this.Collection.Count  Else    Err.Raise 457, Widget.Add, The key ' & Key & ' is already associated with an element of this collection  End IfEnd SubPublic Function CreateWidget(ByVal ID As String, ByVal Name As String, ByVal ReleaseDate As Date) As WidgetAttribute CreateWidget.VB_Description = A factory method for creating a new Widget.  With New Widget    .ID = ID    .Name = Name    .ReleaseDate = ReleaseDate    Set CreateWidget = .Self  End WithEnd FunctionProperty Get Count() As LongAttribute Count.VB_Description = Returns the number Widgets in the collection.  Count = this.Keys.CountEnd PropertyPublic Function Exists(ByVal ID As String) As BooleanAttribute Exists.VB_Description = Confirms whether a particular Widget exists in the collection.  Exists = this.Keys.Exists(ID)End FunctionPublic Property Get Item(ByVal IDOrIndex As Variant) As WidgetAttribute Item.VB_Description = Default Property. Returns a Widget by ID or Index.Attribute Item.VB_UserMemId = 0  Dim index As Long  If this.Keys.Exists(IDOrIndex) Then    index = this.Keys(IDOrIndex)  Else    If IsLongInteger(IDOrIndex) Then      index = CLng(IDOrIndex) + (1 - COLLECTION_BASE)      If index < 1 Or index > this.Collection.Count Then        Err.Raise 9, Widgets.Item, Index  & IDOrIndex &  is out of range. Widgets is  & COLLECTION_BASE & -based        Exit Property      End If    Else      Err.Raise 9, Widgets.Item, ID ' & IDOrIndex & ' is out of range.      Exit Property    End If  End If  Set Item = this.Collection.Item(index)End PropertyPublic Sub Remove(ByVal IDOrIndex As Variant)Attribute Remove.VB_Description = Removes a Widget by ID/Key or Index.  Dim oneBasedIndex As Long  Dim Key As String  If this.Keys.Exists(IDOrIndex) Then    Key = IDOrIndex    oneBasedIndex = this.Keys(Key)  Else    If IsLongInteger(IDOrIndex) Then      oneBasedIndex = CLng(IDOrIndex) + (1 - COLLECTION_BASE)      If oneBasedIndex >= 1 And oneBasedIndex <= this.Collection.Count Then        Key = this.Keys.Keys(oneBasedIndex - 1)      Else        Err.Raise 9, Widgets.Remove, Index  & IDOrIndex &  is out of range. Widgets is  & COLLECTION_BASE & -based      End If    Else        Err.Raise 9, Widgets.Remove, Key ' & IDOrIndex & ' is out of range.    End If  End If  this.Collection.Remove oneBasedIndex  this.Keys.Remove Key  Dim Keys As Variant  Keys = this.Keys.Keys  Dim items As Variant  items = this.Keys.items  Dim nextkey As String  Dim nextIndex As Long  'Now decrement the indexes for all subsequent keys  For nextIndex = oneBasedIndex - 1 To this.Keys.Count - 1    nextkey = this.Keys.Keys(nextIndex)    this.Keys.Item(nextkey) = nextIndex + 1    items = this.Keys.items    Keys = this.Keys.Keys  Next nextIndexEnd SubPublic Sub RemoveAll()Attribute RemoveAll.VB_Description = Removes all Widgets in the collection.  Set this.Collection = New Collection  Set this.Keys = New Scripting.DictionaryEnd SubPublic Function Keys() As VariantAttribute Keys.VB_Description = Returns a Variant array of the Widget IDs in the collection.  Keys = this.Keys.KeysEnd FunctionPrivate Function IsLongInteger(ByVal Expression As Variant) As BooleanAttribute IsLongInteger.VB_Description = Private helper to see if a key is a numeric index.  IsLongInteger = False  If IsNumeric(Expression) Then    If CLng(Expression) = Expression Then      IsLongInteger = True      Exit Function    End If  End IfEnd FunctionWidget upon WidgetAnd putting it to use:Sub foo()  Dim coll As Widgets  Dim widg As Widget  Set coll = New Widgets  coll.Add coll.CreateWidget(ABC, ABC Widget, Now())  coll.Add coll.CreateWidget(BCD, BCD Widget, Now())  coll.Add coll.CreateWidget(CDE, CDE Widget, Now())  coll.Add coll.CreateWidget(DEF, DEF Widget, Now())  'Enumerate the collection  For Each widg In coll    Debug.Print widg.Name  Next  'Check a Widget exists by ID  If coll.Exists(DEF) Then    Debug.Print coll(DEF).ReleaseDate  End If  'Remove by 0-based index  coll.Remove 0  'Remove by Widget ID  coll.Remove DEF  'Enumerate the collection  For Each widg In coll    Debug.Print widg.ID  NextEnd SubOutput:ABC WidgetBCD WidgetCDE WidgetDEF Widget23/02/2017 3:10:45 PM BCDCDEI've sacrificed a few features of Collection (like being able to add a Widget before or after an existing collection key), and I haven't honored the CompareMethod of a Dictionary, but these are easily added.Have I missed anything? Am I missing some performance tweaks?
Enumerable Custom Collections in VBA with Dictionary features like Exists
vba;dictionary;collections