A method for managing enumerations in VBA

Question

I have for some time been frustrated by the limitations around enumerations in VBA. Googling didn't find anything really simple and comprehensive. So after a bit of head scratching I came up with the following code which provides a neat intellisense based solution for managing enums to allow easy access to:

• member names
• counting members
• enumerating members correctly
• testing if an enum member exists

The code is contained in a Class with a PredeclaredId and the Class Name used was Enums. Most of what I've achieved could have been done by just using a Scripting.Dictionary, but you would not get the intellisense that the code below provides.

Option Explicit
'@PredeclaredId
'@Exposed

Public Enum EnumAction
    
    AsEnum
    AsString
    AsExists
    AsDictionary
    AsCount
    
End Enum

Public Enum TestingEnum
    
    'AsProperty is assigned -1 because it is not included in the backing dictionary
    ' and we want the enummeration to start at 0 unless defined otherwise
    AsProperty = -1
    Apples
    Oranges
    Cars
    Lemons
    Trees
    Giraffes
    
End Enum


Private Type Enumerations
    
    Testing             As Scripting.Dictionary
    
End Type

Private e               As Enumerations

Private Sub Class_Initialize()
    
    If Not Me Is Enums Then
        
        VBA.Err.Raise _
            17, _
            "Enumerations.ClassInitialize", _
            "Class Enums:New'ed Instances of Class Enums are not allowed"
        
    End If
    
End Sub

Private Sub PopulateTesting()
        
    Set e.Testing = New Scripting.Dictionary

    With e.Testing
        ' Note: AsProperty is not included in the dictionary
        .Add Apples, "Apples"
        .Add Oranges, "Oranges"
        .Add Cars, "Cars"
        .Add Lemons, "Lemons"
        .Add Trees, "Trees"
        .Add Giraffes, "Giraffes"
        
    End With
    
End Sub

Public Property Get Testing(ByVal ipEnum As TestingEnum, Optional ByVal ipAction As EnumAction = EnumAction.AsEnum) As Variant
    
    If e.Testing Is Nothing Then PopulateTesting
    
    Select Case ipAction
        
        Case EnumAction.AsEnum
        
            Testing = ipEnum
            
        Case EnumAction.AsString
        
            Testing = e.Testing.Item(ipEnum)
            
        Case EnumAction.AsExists
        
            Testing = e.Testing.Exists(ipEnum)
            
        Case EnumAction.AsCount
        
            Testing = e.Testing.Count
            
        Case EnumAction.AsDictionary
        
            Dim myDictionary As Scripting.Dictionary
            Set myDictionary = New Scripting.Dictionary
            
            Dim myKey As Variant
            For Each myKey In e.Testing
                
                myDictionary.Add myKey, e.Testing.Item(myKey)
                
            Next
            
            Set Testing = myDictionary
            
    End Select
    
End Property
    

Usage

Public Sub Test()

    Const Bannannas As Long = 42
    Debug.Print "Enum value of lemons is 3", Enums.Testing(Lemons)
    Debug.Print "String is Lemons", Enums.Testing(Lemons, AsString)
    Debug.Print "Bannannas are False", Enums.Testing(Bannannas, AsExists)
    ' The AsProperty member is the preferred awkwardness
    ' as it is a 'Foreign' member just used to make the
    ' intellisense a bit more sensible.
    ' in practise any enumeration member could be used as
    ' the count and dictionary cases ignore the input enum.
    Debug.Print "Count is 6", Enums.Testing(AsProperty, AsCount)
    Dim myKey As Variant
    Dim myDictionary As Scripting.Dictionary
    Set myDictionary = Enums.Testing(AsProperty, AsDictionary)
    For Each myKey In myDictionary
    
        Debug.Print myKey, myDictionary.Item(myKey)
        
    Next
    
    Dim mykeys As Variant
    mykeys = Enums.Testing(AsProperty, AsDictionary).Keys
    
    Dim myvalues As Variant
    myvalues = Enums.Testing(AsProperty, AsDictionary).Items
    Debug.Print "Apples are apples", myDictionary.Item(Enums.Testing(Apples))
    myDictionary.Item(Enums.Testing(Apples)) = "Plums"
   
    Debug.Print "Apples are plums", myDictionary.Item(Enums.Testing(Apples))
    Debug.Print "Apples are apples", Enums.Testing(Apples, AsString)
    
    
End Sub

test output

Enum value of lemons is 3    3 
String is Lemons            Lemons
 Test is False              False
Count is 6     6 
 0            Apples
 1            Oranges
 2            Cars
 3            Lemons
 4            Trees
 5            Giraffes
Apples are apples           Apples
Apples are plums            Plums
Apples are apples           Apples

There are some awkwardnesses with the code above:

• no support for enums as default values for optional parameters

• no assignment of enums to constants

• a Local variable could be defined with the same name as an enum member but with a non existing, or worse, alternative value to the enumeration member

• The use of the 'AsProperty' 'Foreign' member of the enumeration (partially handled by not including that member in the backing scripting.dictionary.

I'd welcome any comments or suggestions for improvements.

Answer 1

I think everybody is frustrated with how enumerations are working in VBA. Not the richest language syntax. As @PeterT mentioned in the comments we all just need to "pick our poison".

There is always some functionality around a single Enum and that could be a simple function or a group of related modules/classes. I would not group all the enums inside a single predeclared class or even a standard module. What if you need to reuse the functionality related to an enum inside another project? You would then need to copy the Enums class/module to that separate project and then trim the extra enums isn't it? Or even worse leave all the enums in there because you don't have the time to do the trimming.

On the other hand, there is one good reason I would not wrap each enum in it's own class just for Intellisense. What if I have 50 enums? Should I add 50 classes to a project which is suffering anyway from having a single class per code module and no inheritance? I would not do it but that's just my subjective point of view. It's difficult to navigate a project even with help from Rubberduck (and even worse without) so I try to minimize the number of code modules.

I've used another "poison" over the years and it seemed to serve me well and of course that does not mean it's better than yours, it's just different and works for me.

Before I start, I must say that the AsEnum feature of your code can be removed because something like Enums.Testing(77) will simply return 77. It's like "give me back the value I gave you" kind of thing really.

A different approach

I am using a general wrapper class but it could be a standard module having the same UDT inside. The reason I prefer a class is because I do not want to pass around a UDT ByRef whenever I write the "wrapper functions" (more on that below). Also, I am not using a Dictionary as I usually do not want to be bound to using just Windows and don't want an extra library reference so instead I use 2 collections for mapping. I have a general class called EnumWrapper with the following code:

Option Explicit

Private Type EnumLists
    arrEnum() As Variant
    arrText() As Variant
    enumToText As Collection
    textToEnum As Collection
End Type

Private m_eLists As EnumLists

Public Sub Init(ByRef arrEnum As Variant, ByRef arrText As Variant)
    With m_eLists
        .arrEnum = arrEnum
        .arrText = arrText
        '
        Set .enumToText = New Collection
        Set .textToEnum = New Collection
        '
        Dim i As Long
        Dim textValue As String
        Dim enumValue As Long
        '
        For i = LBound(.arrEnum) To UBound(.arrEnum)
            enumValue = .arrEnum(i)
            textValue = .arrText(i)
            '
            .enumToText.Add textValue, CStr(enumValue)
            .textToEnum.Add enumValue, textValue
        Next i
    End With
End Sub

Public Function Count() As Long
    Count = m_eLists.enumToText.Count
End Function

Public Function Exists(ByVal enumValue As Long) As Boolean
    On Error Resume Next
    m_eLists.enumToText.Item CStr(enumValue)
    Exists = (Err.Number = 0)
    On Error GoTo 0
End Function

Public Function FromString(ByVal textValue As String _
                         , Optional ByVal valueIfNotFound As Long) As Long
    On Error Resume Next
    FromString = m_eLists.textToEnum(textValue)
    If Err.Number <> 0 Then FromString = valueIfNotFound
    On Error GoTo 0
End Function

Public Function Items() As Variant()
    Items = m_eLists.arrEnum
End Function

Public Function Self() As EnumWrapper
    Set Self = Me
End Function

Public Function Texts() As Variant()
    Texts = m_eLists.arrText
End Function

Public Function ToString(ByVal enumValue As Long _
                       , Optional ByVal valueIfNotFound As String) As String
    On Error Resume Next
    ToString = m_eLists.enumToText(CStr(enumValue))
    If Err.Number <> 0 Then ToString = valueIfNotFound
    On Error GoTo 0
End Function

We could write more code for validation and raising errors in the Init method but I kept it simple for the purpose of this answer.

I then proceed to wrap an instance of this class for each enum that I need so I get the proper Intellisense. For example for your TestingEnum I would do the following wherever the enum is actually placed (class/document/standard module - doesn't really matter):

Option Explicit

Public Enum TestingEnum
    InvalidValue = -1
    Apples
    Oranges
    Cars
    Lemons
    Trees
    Giraffes
End Enum

Private Function GetTestingWrapper() As EnumWrapper
    Static eWrapper As EnumWrapper
    '
    If eWrapper Is Nothing Then
        Set eWrapper = New EnumWrapper
        eWrapper.Init Array(Apples, Oranges, Cars, Lemons, Trees, Giraffes) _
                    , Array("Apples", "Oranges", "Cars", "Lemons", "Trees", "Giraffes")
    End If
    Set GetTestingWrapper = eWrapper
End Function
Public Function TestingEnumToString(ByVal enumValue As TestingEnum) As String
    TestingEnumToString = GetTestingWrapper.ToString(enumValue) 'Could use optional parameter to return specific string on failure
End Function
Public Function TestingEnumFromString(ByVal textValue As String) As TestingEnum
    TestingEnumFromString = GetTestingWrapper.FromString(textValue, InvalidValue)
End Function
Public Function TestingEnumExists(ByVal enumValue As TestingEnum) As Boolean
    TestingEnumExists = GetTestingWrapper.Exists(enumValue)
End Function
Public Function TestingEnumCount() As Long
    TestingEnumCount = GetTestingWrapper.Count
End Function
Public Function TestingEnumItems() As Variant()
    TestingEnumItems = GetTestingWrapper.Items
End Function
Public Function TestingEnumTexts() As Variant()
    TestingEnumTexts = GetTestingWrapper.Texts
End Function

Typing TestingEnum would make the Intellisense look like this:

All methods are easy to find and can't really forget their names as they all start with the enum name.

An example of method call:

Of course, sometimes you don't need all of these "wrapper" methods so you would just write the ones you need which helps minimize the bloating.

Your tests would then become:

Option Explicit

Public Sub Test()
    Const Bannannas As Long = 42
    Debug.Print "Enum value of lemons is 3", TestingEnumFromString("Lemons")
    Debug.Print "String is Lemons", TestingEnumToString(Lemons)
    Debug.Print "Bannannas are False", TestingEnumExists(Bannannas)
    Debug.Print "Count is 6", TestingEnumCount()
    
    Dim myEnumValue As Variant
    For Each myEnumValue In TestingEnumItems()
        Debug.Print myEnumValue, TestingEnumToString(myEnumValue)
    Next
    
    Dim myEnums As Variant
    myEnums = TestingEnumItems()
    
    Dim myTexts As Variant
    myTexts = TestingEnumTexts()
    
    Debug.Print "Apples are apples", TestingEnumToString(Apples)
End Sub

I removed the "replace apples with plums" part as I don't see the point of that. The purpose of an Enum is to be "constant". If there is a need to change the texts that should happen in the GetTestingWrapper method and of course those values could come from a different source (like a table).

Of course this approach is bloating the global namespace but I can live with that as long as I gain the advantage of placing the code for each enum in the module/class where it actually belongs along other related functionality and this helps with portability with the downside that I also need to carry the EnumWrapper class module.

The bloating would happen anyway even if you were to add all enums to a single class or a separate class per enum because you still need the Intellisense at least for the ToString, FromString and Exists methods. Less true for the Count, Items and Texts methods but this is just part of this approach.

Having 3 lines of code for each "wrapper" method (out of which one is the function definition and one is End Function) is not really a big deal and overall seems cleaner to my subjective view.

Answer 2

Some thought in no particular order:

---

Could the Enums predeclared Class be a standard module? That would avoid the need to have this check:

Private Sub Class_Initialize()
    
    If Not Me Is Enums Then
        
        VBA.Err.Raise _
            17, _
            "Enumerations.ClassInitialize", _
            "Class Enums:New'ed Instances of Class Enums are not allowed"
        
    End If
    
End Sub

And would make prepending Enums optional. The downside would be PopulateTesting isn't automatically called (I assume you meant to call it in Class_Initialize), but you can call it upon first invocation of Public Property Get Testing which would save a hit at runtime if you have many enums to populate but only a few are actually required. edit: in your updated code I see you've gone with the lazy populate option

Incidentally if we're being perfectionists, I would rather see this above code written as a named guard clause - and why magic 17?

---

Private Type Enumerations
    
    Testing             As Scripting.Dictionary
    
End Type

Private e               As Enumerations

Why is this module level? If I add a second enum, why does it need to know about the e.Testing dictionary? I'd use a Static variable inside the sub.

Also I'd probably rename e.Testing to this.TestingMap or even this.TestingNamesFromEnumValues.

---

There's a lot of boilerplate adding a new Enum to this class, particularly this big select case block:

Select Case ipAction
    
    Case EnumAction.AsEnum
    
        Testing = ipEnum
        
    Case EnumAction.AsString
    
        Testing = e.Testing.Item(ipEnum)
        
    Case EnumAction.AsExists
    
        Testing = e.Testing.Exists(ipEnum)
        
    Case EnumAction.AsCount
    
        Testing = e.Testing.Count
        
    Case EnumAction.AsDictionary
    
        Dim myDictionary As Scripting.Dictionary
        Set myDictionary = New Scripting.Dictionary
        
        Dim myKey As Variant
        For Each myKey In e.Testing
            
            myDictionary.Add myKey, e.Testing.Item(myKey)
            
        Next
        
        Set Testing = myDictionary
        
End Select

... wouldn't want to write that out too many times! This could be extracted into a private function which takes the dictionary/ enum name as a parameter - maybe the class stores a collection of enumName:lookupDictionary pairs rather than hard coding them in a UDT.

---

The EnumAction stuff is kinda weird, I see why you've done it but honestly these actions are just begging to be methods of a class.

I think another approach here would be to have 1 class for each enum, maybe even predeclared and shadowing the enum name, although a strongly typed member of a global collection could be a neater API (so a property get Testing() As TestingEnum). You can then just write some helper functions for letting these classes register their members somewhere, quickly look them up or look up properties about them, and then the enum classes can use these to implement the actions you want without repeating too much boilerplate. For standard methods like Count or AsDictionary, your Enum objects could implement a standard interface, perhaps with an easy accessor for the interface:

Interface: IEnum

Public Property Get Count() As Long

Public Function AsDictionary() As Dictionary

Class: TestingEnum

Public Property Get Info() As IEnum
    Set Info = Me
End Property

then you can do TestingEnum.Info.Count for example. Or a caller can cast to IEnum and call .Count themselves. You get the idea.

---

Scripting.Dictionary doesn't expose an IEnumVariant member like Collections do, but you could expose a generator function to allow your enums to be used in a for each loop

---

Public Enum TestingEnum
    
    'AsProperty is assigned -1 because it is not included in the backing dictionary
    ' and we want the enummeration to start at 0 unless defined otherwise
    AsProperty = -1
    Apples
    Oranges
    Cars
    Lemons
    Trees
    Giraffes
    
End Enum

I would expose a constant from your class so users know -1 isn't a hard requirement:

Public Const AsPropertyEnumValue As Long = -1 'or anything really
'...
Public Enum TestingEnum
    AsProperty = AsPropertyEnumValue 

Having a default 0 starting position is a weird requirement I think you should scrap, if the user wants Apples to be 0, they should set it to zero. Abstracting away the implementation of this AsProperty member will encourage the user not to assume any particular starting value.

If you switch to methods defined in an interface rather than by this Action parameter then the AsProperty member can be removed or made [_hidden] as an implementation detail.

Answer 3

Since VBA/VB6 treats Enums as Longs under the hood, so I suggest a generic wrapper to which you can supply your Enums and their string representations. This way you avoid having to have a separate class for each one.

Let's start with a generic class that serves a two-way or "bi-directional" map, which I have aptly named BiDirectionalMap.

BiDirectionalMap.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "BiDirectionalMap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
'@Exposed
'@PredeclaredId
Option Explicit

Private Enum BiDirectionalMapErrors
    MismatchedLength = vbObjectError + 1024
    SetsNotIterable
    KeyDoesNotExist
    ValueDoesNotExist
    KeyOrValueDoesNotExist = KeyDoesNotExist Or ValueDoesNotExist
End Enum

Private Const MismatchedLengthErrorDesc As String = "Keys and Values must have have the same number of values (i.e. one-to-one correspondence)."
Private Const SetsNotIterableErrorDesc As String = "Key(s), Value(s), or both are is not iterable. For single values, wrap in 'Array()' function."
Private Const DoesNotExistErrorDesc As String = "does not exist. Ensure that the data type is consistent with the original "

Private Type TBiDirectionalMap
    KeyCompareMethod As VBA.VbCompareMethod
    ValueCompareMethod As VBA.VbCompareMethod

    KeysDict As Scripting.Dictionary
    ValuesDict As Scripting.Dictionary
End Type

Private this As TBiDirectionalMap

Public Function Create(ByVal keys As Variant, ByVal values As Variant, _ 
Optional ByVal keyCompareMethod As VBA.VbCompareMethod = vbBinaryCompare, _ 
Optional ByVal valueCompareMethod As VBA.VbCompareMethod = vbBinaryCompare) As BiDirectionalMap
    Errors.GuardNonDefaultInstance Me, BiDirectionalMap, VBA.TypeName(Me)

    Dim result As BiDirectionalMap
    Set result = New BiDirectionalMap
    result.KeyCompareMethod = keyCompareMethod
    result.ValueCompareMethod = valueCompareMethod

    result.AddRange keys, values

    Set Create = result
End Function

Public Property Get KeyCompareMethod() As VBA.VbCompareMethod
  KeyCompareMethod = this.KeyCompareMethod
End Property
Friend Property Let KeyCompareMethod(ByVal value As VBA.VbCompareMethod)
    Errors.GuardNullReference this.KeysDict, VBA.TypeName(Me) & "." & "KeyCompareMethod"

    this.KeyCompareMethod = value

    If this.KeysDict.Count = 0 Then 
        this.KeysDict.CompareMode = this.KeyCompareMethod
    
    End If 
End Property

Public Property Get ValueCompareMethod() As VBA.VbCompareMethod
  ValueCompareMethod = this.ValueCompareMethod
End Property
Friend Property Let ValueCompareMethod(ByVal value As VBA.VbCompareMethod)
    Errors.GuardNullReference this.ValuesDict, VBA.TypeName(Me) & "." & "ValueCompareMethod"

    this.ValueCompareMethod = value

    If this.ValuesDict.Count = 0 Then 
        this.ValuesDict.CompareMode = this.ValueCompareMethod
    
    End If 
End Property

Public Property Get Count() As Long
    If this.KeysDict.Count = this.ValuesDict.Count Then
        Count = this.KeysDict.Count

    Else
        Errors.ThrowError BiDirectionalMapErrors.MismatchedLength, _ 
                          VBA.TypeName(Me) & "." & "Count()", _ 
                          GetErrorMessage(BiDirectionalMapErrors.MismatchedLength) 

    End If
End Property

Public Property Get Keys() As Scripting.Dictionary
    Set Keys = this.KeysDict
End Property

Public Property Get Values() As Scripting.Dictionary
    Set Values = this.ValuesDict
End Property

Public Property Get Key(ByVal valueKey As Variant) As Variant
    If this.ValuesDict.Exists(valueKey) Then
        AssignProperty(Key) = this.ValuesDict(valueKey)

    Else
        Errors.ThrowError BiDirectionalMapErrors.KeyDoesNotExist, _ 
                          VBA.TypeName(Me) & "." & "Get Key()", _ 
                          GetErrorMessage(BiDirectionalMapErrors.KeyDoesNotExist) 

    End If
End Property

Public Property Let Key(ByVal valueKey As Variant, ByVal value As Variant)
    this.KeysDict(valueKey) = value
    this.ValuesDict(value) = valueKey
End Property

Public Property Set Key(ByVal valueKey As Variant, ByVal value As Variant)
    Set this.KeysDict(valueKey) = value
    Set this.ValuesDict(value) = valueKey
End Property

Public Property Get Value(ByVal keyValue As Variant) As Variant
    If this.KeysDict.Exists(keyValue) Then
        AssignProperty(Value) = keyValue

    Else
        Errors.ThrowError BiDirectionalMapErrors.ValueDoesNotExist, _ 
                          VBA.TypeName(Me) & "." & "Get Value()", _ 
                          GetErrorMessage(BiDirectionalMapErrors.ValueDoesNotExist) 

    End If
End Property

Public Property Let Value(ByVal keyValue As Variant, ByVal key As Variant)
    this.ValuesDict(keyValue) = key
    this.KeysDict(key) = keyValue
End Property

Public Property Set Value(ByVal keyValue As Variant, ByVal key As Variant)
    Set this.ValuesDict(keyValue) = key
    Set this.KeysDict(key) = keyValue
End Property


Public Function ContainsKey(ByVal key As Variant) As Boolean
    ContainsKey = this.KeysDict.Exists(key)
End Function

Public Function ContainsValue(ByVal value As Variant) As Boolean
    ContainsValue = this.ValuesDict.Exists(value)
End Function

Public Function ContainsPair(ByVal key As Variant, ByVal value As Variant) As Boolean
    ContainsPair = (ContainsKey(key) And ContainsValue(value))
End Function

Public Sub AddRange(ByVal keys As Variant, ByVal values As Variant)
    Errors.GuardNullReference this.KeysDict, VBA.TypeName(Me) & "." & "AddRange()"
    Errors.GuardNullReference this.ValuesDict, VBA.TypeName(Me) & "." & "AddRange()"

    Dim keysColl As Collection
    Set keysColl = IterableToCollection(keys)

    Dim valuesColl As Collection
    Set valuesColl = IterableToCollection(values)

    If keysColl.Count <> valuesColl.Count Then 
        Errors.ThrowError BiDirectionalMapErrors.MismatchedLength, _ 
                          VBA.TypeName(Me) & "." & "AddRange()", _ 
                          GetErrorMessage(BiDirectionalMapErrors.MismatchedLength) 

    End If 

    Dim i As Long
    For i = 1 To keysColl.Count
        Add keysColl(i), valuesColl(i)

    Next i
End Sub

Public Sub Add(ByVal key As Variant, ByVal value As Variant)
    On Error GoTo CleanFail
    this.KeysDict.Add key, value
    this.ValuesDict.Add value, key

CleanExit:
    Exit Sub

CleanFail:
    Errors.ThrowError Err.Number, VBA.TypeName(Me) & "." & "Add()", Err.Description

Resume CleanExit
End Sub

Public Sub RemoveRange(ByVal keysOrValues As Variant)
    Dim keysOrValueColl As Collection
    Set keysOrValueColl = IterableToCollection(keysOrValues)
    
    Dim i As Long
    For i = 1 To keysOrValueColl.Count
        Remove keysOrValueColl(i)

    Next i
    
End Sub

Public Sub Remove(ByVal keyOrValue As Variant)
    If ContainsKey(keyOrValue) Then 
        Dim val As Variant 
        val = Value(keyOrValue)
        
        this.KeysDict.Remove keyOrValue
        this.ValuesDict.Remove val
        
    ElseIf ContainsValue(keyOrValue) Then 
        Dim key As Variant 
        key = Key(keyOrValue)
        
        this.ValuesDict.Remove key
        this.KeysDict.Remove keyOrValue
        
    Else 
        Errors.ThrowError BiDirectionalMapErrors.KeyOrValueDoesNotExist, _ 
                          VBA.TypeName(Me) & "." & "Remove()", _ 
                          GetErrorMessage(BiDirectionalMapErrors.KeyOrValueDoesNotExist) 
    
    End If
    
End Sub

Public Sub Clear()
    If this.KeysDict.Count > 0 Then 
        this.KeysDict.RemoveAll
        
    End If 
    
    If this.ValuesDict.Count > 0 Then 
        this.ValuesDict.RemoveAll
        
    End If 
End Sub

'*****************************************************************************************
'Private Methods / Properties
'*****************************************************************************************
Private Sub Class_Initialize()
    Errors.GuardDoubleInitialization this.KeysDict, VBA.TypeName(Me) & "." &  "Class_Initialize()"
    Set this.KeysDict = New Scripting.Dictionary

    Errors.GuardDoubleInitialization this.ValuesDict, VBA.TypeName(Me) & "." &  "Class_Initialize()"
    Set this.ValuesDict = New Scripting.Dictionary
End Sub

Private Function IterableToCollection(ByVal iterable As Variant) As Collection
    Select Case VBA.VarType(iterable)
        Case (vbArray + vbVariant)  '8204; https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/vartype-function
            Set IterableToCollection = ArrayToCollection(iterable)

        Case vbObject
            Set IterableToCollection = ObjectToCollection(iterable)

    End Select
End Function

Private Function ArrayToCollection(ByVal variantArray As Variant) As Collection
    ValidateArrayDimensions variantArray, "ArrayToCollection()"

    Dim result As Collection
    Set result = New Collection

    Dim dimensions As Long
    dimensions = GetArrayDimensions(variantArray)

    Dim i As Long
    On Error GoTo CleanFail
    Select Case dimensions
        Case 1
            For i = LBound(variantArray) To UBound(variantArray)
                result.Add variantArray(i)

            Next i

        Case 2
            Dim secondDimLBound As Long
            secondDimLBound = LBound(variantArray, 1)

            For i = LBound(variantArray, 1) To UBound(variantArray, 1)
                result.Add variantArray(i, secondDimLBound)

            Next i

    End Select

    Set ArrayToCollection = result

CleanExit:
    Exit Function

CleanFail:
    ManageIterableError Err.Number, "ArrayToCollection()"

    Resume CleanExit
End Function

Private Function ObjectToCollection(ByVal obj As Variant) As Collection
    Dim result As Collection
    Set result = New Collection

    On Error GoTo CleanFail
    Dim value As Variant
    For Each value In obj
        result.Add value

    Next

    Set ObjectToCollection = result

CleanExit:
    Exit Function

CleanFail:
    ManageIterableError Err.Number, "ObjectToCollection()"

Resume CleanExit
End Function


Private Property Let AssignProperty(ByRef returnValue As Variant, ByVal value As Variant)
    If IsObject(value) Then
        Set returnValue = value

    Else
        returnValue = value

    End If
End Property


'*****************************************************************************************
'Error Handling
'*****************************************************************************************
Private Sub ValidateArrayDimensions(ByVal variantArray As Variant, ByVal methodName As String)
    Dim dimensions As Long
    dimensions = GetArrayDimensions(variantArray)

    Select Case dimensions
        Case Is > 2
            Errors.ThrowError BiDirectionalMapErrors.SetsNotIterable, VBA.TypeName(Me) & "." & methodName

        Case Is = 2
            Errors.GuardExpression IsMultiColumnArray(variantArray), BiDirectionalMapErrors.SetsNotIterable, VBA.TypeName(Me) & "." & methodName

    End Select
End Sub
  
Private Sub ManageIterableError(ByVal errorNumber As Long, ByVal methodName As String)
    Select Case errorNumber
        Case Errors.ObjectDoesNotSupportMethodRuntimeError, Errors.TypeMismatchRuntimeError
            Errors.ThrowError BiDirectionalMapErrors.SetsNotIterable, _ 
                              VBA.TypeName(Me) & "." & methodName, _ 
                              GetErrorMessage(BiDirectionalMapErrors.SetsNotIterable)

        Case Else
            Errors.ThrowError errorNumber, _ 
                              VBA.TypeName(Me) & "." & methodName, _ 
                              Err.Description 

    End Select  
End Sub

Private Function GetErrorMessage(ByVal errorNumber As BiDirectionalMapErrors) As String
    Dim result As String 

    Select Case errorNumber
        Case BiDirectionalMapErrors.MismatchedLength
            result = MismatchedLengthErrorDesc

        Case BiDirectionalMapErrors.SetsNotIterable
            result = SetsNotIterableErrorDesc

        Case BiDirectionalMapErrors.KeyDoesNotExist
            result = "Key " & DoesNotExistErrorDesc & " keys."

        Case BiDirectionalMapErrors.ValueDoesNotExist
            result = "Value " & DoesNotExistErrorDesc & " values."
            
        Case BiDirectionalMapErrors.KeyOrValueDoesNotExist
            result = "Key or Value " & DoesNotExistErrorDesc & " keys or values."

    End Select

    GetErrorMessage = result
End Function

Private Function GetArrayDimensions(ByVal variantArray As Variant) As Long
    Dim index As Long
    On Error Resume Next
    Err.Clear

    Dim upperBound As Long
    Do
        index = index + 1
        upperBound = UBound(variantArray, index)

    Loop Until Err.Number <> 0
    On Error GoTo 0

    GetArrayDimensions = (index - 1)
End Function

Private Function IsMultiColumnArray(ByVal variantArray As Variant) As Boolean
    On Error Resume Next
    Err.Clear

    Dim value As Variant
    value = variantArray(LBound(variantArray), 2)

    IsMultiColumnArray = (Err.Number = 0)
    On Error GoTo 0
End Function

Essentially, all we are doing is tracking keys and values in 2 separate dictionaries. The underlying KeysDict has key == key and value == value, while the ValuesDict has key == value and value == key. We want to ensure that they are in sync at all times so as to maintain the bijection of the keys/values.

Now we can follow up with a wrapper to work specifically with Enums.

EnumMap.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "EnumMap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
'@Exposed
'@PredeclaredId
Option Explicit

Private Mappings As BiDirectionalMap

Public Function Create(ByVal enumns As Variant, ByVal names As Variant, _ 
Optional ByVal nameCompareMethod As VBA.VbCompareMethod = vbBinaryCompare) As EnumMap
    Errors.GuardNonDefaultInstance Me, EnumMap, VBA.TypeName(Me) & "." & "Create()"

    Dim result As EnumMap
    Set result = New EnumMap

    result.SetMappings enumns, names, nameCompareMethod

    Set Create = result
End Function

Public Property Get Count() As Long
    Errors.GuardNullReference Mappings, VBA.TypeName(Me) & "." & "Count()"
    
    Count = Mappings.Count
End Property

Public Property Get Enumns() As Scripting.Dictionary
    Errors.GuardNullReference Mappings, VBA.TypeName(Me) & "." & "Enumns()"
    
    Set Enumns = Mappings.Keys
End Property

Public Property Get Names() As Scripting.Dictionary
    Errors.GuardNullReference Mappings, VBA.TypeName(Me) & "." & "Names()"
    
    Set Names = Mappings.Values
End Property

Public Function ToEnum(ByVal name As String) As Long
    Errors.GuardNullReference Mappings, VBA.TypeName(Me) & "." & "ToEnum()"
      
    ToEnum = Mappings.Key(name)
End Function

Public Function ToName(ByVal enumValue As Long) As String
    Errors.GuardNullReference Mappings, VBA.TypeName(Me) & "." & "ToName()"
     
    ToName = Mappings.Value(enumValue)
End Function


Friend Sub SetMappings(ByVal enumns As Variant, ByVal names As Variant, _ 
ByVal nameCompareMethod As VBA.VbCompareMethod)
    If Mappings Is Nothing Then
        Set Mappings = BiDirectionalMap.Create(enumns, names, vbBinaryCompare, nameCompareMethod)

        Exit Sub

    End If

    If Mappings.Count = 0 Then
        Set Mappings = BiDirectionalMap.Create(enumns, names, vbBinaryCompare, nameCompareMethod)

    End If
End Sub

The we can test like so:

Public Enum TestingEnum
    Apples
    Oranges
    Cars
    Lemons
    Trees
    Giraffes
End Enum

Private Sub Tester()
    Dim enumValues() As Variant
    enumValues() = Array(Apples, Oranges, Cars, Lemons, Trees, Giraffes)
    
    Dim enumNames() As Variant
    enumNames() = Array("Apples", "Oranges", "Cars", "Lemons", "Trees", "Giraffes")

    Dim map As EnumMap
    Set map = EnumMap.Create(enumValues, enumNames)
    
    Debug.Print map.ToEnum("Cars")
    Debug.Print map.ToName(Cars)

    Debug.Print map.Count()
    
    Debug.Assert map.names.Exists("Trucks")
    
    Debug.Assert map.enumns.Exists(10)
End Sub

The only caveat with a generic wrapper is that does not support intellisense, but the reusability/portability that it affords outways this in my mind.

For reference, below is the Errors module referenced in the 2 classes above.

Errors.bas

Attribute VB_Name = "Errors"
Option Explicit

Public Const InvalidProcedureCallOrArgumentError As Long = 5
Public Const TypeMismatchRuntimeError As Long = 13              
Public Const ObjectDoesNotSupportMethodRuntimeError As Long = 438   
Public Const ObjectAlreadyInitializedError As Long = 1004       'Technically this is an Application-defined or object-defined error


Public Const InvalidProcedureCallOrArgumentErrorDesc As String = "Invalid procedure call or argument."
Public Const ObjectAlreadyInitializedErrorDesc As String = "Object is already initialized."
Public Const NonDefaultInstanceErrorDesc As String = "Method should be invoked from the default/predeclared instance of this class."
Public Const NullObjectErrorDesc As String = "Object reference cannot be Nothing."

Public Sub GuardNonDefaultInstance(ByVal instance As Object, ByVal defaultInstance As Object, _
Optional ByVal source As String = "Errors", _
Optional ByVal message As String = NonDefaultInstanceErrorDesc)
    GuardExpression Not instance Is defaultInstance, errorNumber:=InvalidProcedureCallOrArgumentError, source:=source, message:=message
End Sub

Public Sub GuardDoubleInitialization(ByVal instance As Object, _
Optional ByVal source As String = "Errors", _
Optional ByVal message As String = ObjectAlreadyInitializedErrorDesc)
    GuardExpression Not instance Is Nothing, errorNumber:=ObjectAlreadyInitializedError, source:=source, message:=message
End Sub

Public Sub GuardNullReference(ByVal instance As Object, _
Optional ByVal source As String = "Errors", _
Optional ByVal message As String = NullObjectErrorDesc)
    GuardExpression instance Is Nothing, errorNumber:=InvalidProcedureCallOrArgumentError, source:=source, message:=message
End Sub

Public Sub GuardExpression(ByVal throw As Boolean, _
Optional ByVal errorNumber As Long = InvalidProcedureCallOrArgumentError, _
Optional ByVal source As String = "Errors", _
Optional ByVal message As String = InvalidProcedureCallOrArgumentErrorDesc)
    If throw Then
        ThrowError IIf(errorNumber = 0, InvalidProcedureCallOrArgumentError, errorNumber), source, message

    End If
End Sub

Public Sub ThrowError(ByVal errorNumber As Long, Optional ByVal source As String = "Errors", _
Optional ByVal message As String = "Invalid procedure call or argument.")
    VBA.Information.Err.Err.Raise errorNumber, source:=source, message:=message
End Sub