Two way key<->value mapping in VBA

TwoDimensionalMapping.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "TwoWayMapping"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'@Folder("Operator Framework.Common")
'@IgnoreModule IndexedDefaultMemberAccess: It's fine for collections I think

Option Explicit
'@PredeclaredId

Private Type mappingData
    AtoB As New Dictionary                       'Use dictionary as this allows any item as key, not just strings as with collections
    BtoA As New Dictionary                       'Auto-instantiate so we don't need growMapping to worry about whether the map was initialised
End Type

Public Enum gtMappingErrors
    [_ErrBase] = 1                               'set to a different value for each class in a project
    mismatchedLengthError = vbObjectError + [_ErrBase]
    setsNotIterableError
    valueNotInMapError
End Enum

Private this As mappingData

Public Function Create(ByVal iterableA As Variant, ByVal iterableB As Variant) As TwoWayMapping
    With New TwoWayMapping
        .growMapping iterableA, iterableB
        Set Create = .Self
    End With
End Function

Friend Property Get Self() As TwoWayMapping
    Set Self = Me
End Property

'@Description("Create key - value pairs mapping items from A to B (and vice-versa) based on each item's index within the collection. iterableA and iterableB should be ordered iterables of equal length. Adds to existing mapping")
Public Sub growMapping(ByVal iterableA As Variant, ByVal iterableB As Variant)
    Const errorSourceName As String = "growMapping" 'CHECK
    
    'need data to be in some form that can be indexed, as For..Each only operates on one at a time
    On Error GoTo readIterableFail
    Dim aValues As Collection
    Set aValues = collectionFromIterable(iterableA)
    
    Dim bValues As Collection
    Set bValues = collectionFromIterable(iterableB)
    
    On Error GoTo cleanFail
    If aValues.Count <> bValues.Count Then raiseError mismatchedLengthError, errorSourceName
    
    Dim i As Long
    For i = 1 To aValues.Count
        this.AtoB.Add aValues(i), bValues(i)
        this.BtoA.Add bValues(i), aValues(i)
    Next i
    Exit Sub
    
readIterableFail:
    Const objectNotIterableError As Long = 438   'object does not support method
    Const typeNotIterableError As Long = 13      'type mismatch
    Select Case Err.Number
        Case objectNotIterableError, typeNotIterableError
            raiseError setsNotIterableError, errorSourceName
            
        Case Else
            raiseError Err.Number, errorSourceName
            
    End Select
    Resume                                       'comment out error raising and break here to debug
    
cleanFail:
    raiseError Err.Number, errorSourceName
    Resume                                       'comment out error raising and break here to debug
    
End Sub

Private Property Get collectionFromIterable(ByVal iterable As Variant) As Collection
    Dim item As Variant
    Dim result As New Collection                 'auto-instantiate so we always return a valid collection, even if no members
    For Each item In iterable
        result.Add item
    Next item
    Set collectionFromIterable = result
End Property

Public Property Get AfromB(ByVal bValue As Variant) As Variant
    Const errorSourceName As String = "AfromB"   'CHECK
    If this.BtoA.Exists(bValue) Then
        Assign(AfromB) = this.BtoA(bValue)
    Else
        raiseError valueNotInMapError, errorSourceName
    End If
End Property

Public Property Get BfromA(ByVal aValue As Variant) As Variant
    Const errorSourceName As String = "BfromA"   'CHECK
    If this.AtoB.Exists(aValue) Then             'without this check, aValue is silently added to the dictionary which is probably not what we want
        Assign(BfromA) = this.AtoB(aValue)
    Else
        raiseError valueNotInMapError, errorSourceName
    End If
End Property

Private Sub raiseError(ByVal errNum As gtMappingErrors, Optional ByVal sourceMethod As String = vbNullString)
    Select Case errNum                           'overwrite description with custom error text - case else would be keep default and rethrow error
        Case gtMappingErrors.mismatchedLengthError
            Err.Description = "iterableA and iterableB must have a 1 to 1 correspondence (i.e. must have the same length)"
            
        Case gtMappingErrors.setsNotIterableError
            Err.Description = "One of iterableA and iterableB is not iterable. For single values, wrap in Array()"
          
        Case gtMappingErrors.valueNotInMapError
            Err.Description = "That value cannot be found in the map, ensure it is of the same data type as the original keys"
            
    End Select
    'REVIEW: does Source actually do anything?
    Err.Raise errNum, Source:=IIf(sourceMethod = vbNullString, TypeName(Me), printf("{0}.{1}", TypeName(Me), sourceMethod))
End Sub

Note this uses Assign which is the Property Let method in this post renamed. Printf can be found here

Public Property Let Assign(ByRef variable As Variant, ByVal value As Variant)
    If IsObject(value) Then
        Set variable = value
    Else
        variable = value
    End If
End Property

Public Function printf(ByVal mask As String, ParamArray tokens()) As String
    Dim i As Long
    For i = 0 To UBound(tokens)
        mask = Replace$(mask, "{" & i & "}", tokens(i))
    Next
    printf = mask
End Function

Also requires a reference to Microsoft Scripting Runtime (scrrun.dll)