How do I add multiple Keys and Values into dictionary at the same time?

Question

I am trying to add a column as the key and the column to the right of it as the value.

Can I do this without a loop?

I tried:

analystDict.Add Key:=refWS.Range("A2:A21"), Item:=refWS.Range("B2:B21")

When I try to Debug.Print I get a Type mismatch error:

For Each x In analystDict.Keys
    Debug.Print x, analystDict(x)
Next x

Answer 1

You can't do this in VBA without writing a helper function.

Option Explicit

Public Sub AddTest()
    Dim analystDict As Scripting.Dictionary
    Set analystDict = New Scripting.Dictionary

    Dim refWS As Worksheet
    Set refWS = ActiveSheet

    AddToDictionary _
        analystDict, _
        Application.WorksheetFunction.Transpose(refWS.Range("A2:A21").Value), _
        Application.WorksheetFunction.Transpose(refWS.Range("B2:B21").Value)

End Sub

Public Sub AddToDictionary(ByRef ipDict As Scripting.Dictionary, ByVal ipKeys As Variant, ByVal ipValues As Variant)

    If UBound(ipKeys) <> UBound(ipValues) Then

        MsgBox "Arrays are not the same size"
        Exit Function

    End If

    Dim myIndex As Long
    For myIndex = LBound(ipKeys) To UBound(ipKeys)

        ipDict.Add ipKeys(myIndex), ipValues(myIndex)

    Next

End Function

Answer 2

You're taking a shortcut that's not allowed; Dictionary.Add is implemented such that it expects one key/value pair, and adds one item to the dictionary. If you need to add multiple items, you need multiple calls to Dictionary.Add - there's no way around it.

A shortcut that would be allowed though, would be to just grab the values in any 2-column Range and turn that into a dictionary, rather than taking any random two arrays that may or may not be the same size.

Make a function that takes a 2D array and turns it into a dictionary by treating the first column as unique keys, and the second column as values.

Public Function ToDictionary(ByVal keyValuePairs As Variant) As Scripting.Dictionary
    If Not IsArray(keyValuePairs) Then Err.Raise 5
    If GetDimensions(keyValuePairs) <> 2 Then Err.Raise 5 'see https://stackoverflow.com/q/6901991/1188513

    Dim result As Scripting.Dictionary
    Set result = New Scripting.Dictionary

    Const KEYCOL = 1, VALUECOL = 2

    Dim i As Long
    For i = LBound(keyValuePairs, KEYCOL) To UBound(keyValuePairs, KEYCOL)
        If result.Exists(keyValuePairs(i, KEYCOL)) Then Err.Raise 457
        result.Add Key:=keyValuePairs(i, KEYCOL), Item:=keyValuePairs(i, VALUECOL)
    Next

    Set ToDictionary = result
End Function

Now you can turn any 2-column Range into a Dictionary like this:

Dim things As Scripting.Dictionary
Set things = ToDictionary(Sheet1.Range("A2:B21").Value)

Note that Range.Value yields a 1-based, 2D Variant array whenever it refers to multiple cells.

Answer 3

Nice concept, Mathieu and you can even simplify this a bit. If you don't mind that a later key-value pair overwrites the most recent one then you can skip raising an error and do this:

Public Function ToDictionary(ByVal keyValuePairs As Variant) As Scripting.Dictionary
    If Not IsArray(keyValuePairs) Then err.Raise 5
    If GetDimensions(keyValuePairs) <> 2 Then err.Raise 5 'see https://stackoverflow.com/q/6901991/1188513

    Dim result As Scripting.Dictionary
    Set result = New Scripting.Dictionary

    Const KEYCOL = 1, VALUECOL = 2

    Dim i As Long
    For i = LBound(keyValuePairs, KEYCOL) To UBound(keyValuePairs, KEYCOL)
        ' No need to check if you don't mind have subsequent instance of key-value overwrite the
        ' the current one.
'        If result.Exists(keyValuePairs(i, KEYCOL)) Then err.Raise 457
        result(keyValuePairs(i, KEYCOL)) = keyValuePairs(i, VALUECOL)
    Next

    Set ToDictionary = result
End Function