What is the easiest way to take two columns of data and convert to dictionary?

You would need to loop, E.g.

Function CreateDictFromColumns(sheet As String, keyCol As String, valCol As String) As Dictionary    Set CreateDictFromColumns = New Dictionary    Dim rng As Range: Set rng = Sheets(sheet).Range(keyCol & ":" & valCol)    Dim i As Long    Dim lastCol As Long '// for non-adjacent ("A:ZZ")    lastCol = rng.Columns.Count    For i = 1 To rng.Rows.Count        If (rng(i, 1).Value = "") Then Exit Function        CreateDictFromColumns.Add rng(i, 1).Value, rng(i, lastCol).Value    NextEnd Function

This breaks on the first empty key value cell.

I think it'd be best form to pass two ranges to a create dictionary function. This allows for the ranges to be completely separate, even different workbooks. It also allows for a 1D range to be mapped to a 2D range as demonstrated below.

Alternatively, you could also pass two arrays of range values. That may be cleaner for 1D ranges, but would result in slightly more code for 2D mapping. Notice that range elements can be looped through left to right top to bottom by index. You can use Application.Transpose(Range("A1:A5")) to effectively run top to bottom left to right.

Jagged Mapping

Sub Test()    RangeToDict Sheets(1).Range("A1:A5"), Sheets(2).Range("C1:E2")End SubFunction RangeToDict(ByVal KeyRng As Range, ByVal ValRng As Range) As Dictionary    Set RangeToDict = New Dictionary    For Each r In KeyRng        vi = vi + 1        'It may not be advisable to handle empty key values this way        'The handling of empty values and #N/A/Error values         'Depends on your exact usage        If r.Value2 <> "" Then            RangeToDict.Add r.Value2, ValRng(vi)            Debug.Print r.Value2 & ", " & ValRng(vi)        End If    NextEnd Function

Side-By-Side (As Range)

If your target range is a single 2 column range side by side, you can simplify to passing a single range as shown below. Consequently, this also works for mapping every other element in a 1 dimensional range.

Sub Test()    RangeToDict2 Range("A1:B5")End SubFunction RangeToDict2(ByVal R As Range) As Dictionary    Set RangeToDict2 = New Dictionary    i = 1    Do Until i >= (R.Rows.Count * R.Columns.Count)        RangeToDict2.Add R(i), R(i + 1)        Debug.Print R(i) & ", " & R(i + 1)        i = i + 2    LoopEnd Function

Two Columns (As Array)

Lastly, as an example of passing arrays as arguments, you could do something like the following. However, the following code will only work given the OP's specific scenario of mapping two columns. As is, it won't handle mapping rows or alternating elements.

Sub Test()    Dim Keys() As Variant: Keys = Range("E1:I1").Value2    Dim Values() As Variant: Values = Range("E3:I3").Value2    RangeToDict Keys, ValuesEnd SubFunction RangeToDict(Keys() As Variant, Values() As Variant) As Dictionary    Set RangeToDict = New Dictionary    For i = 1 To UBound(Keys)        RangeToDict.Add Keys(i, 1), Values(i, 1)        Debug.Print Keys(i, 1) & ", " & Values(i, 1)    NextEnd Function

Use of Named Ranges

It may be convenient to used named ranges, in which case you can pass a Range as an argument likes this...

Sub Test()    RangeToDict Names("Keys").RefersToRange, Names("Values").RefersToRangeEnd Sub

The best approach to take, is to populate a variant array with the data from the worksheet. You can then loop through the array, assigning the elements of the first array column as the dictionary key; the elements of the second array column can then be used as the value.

The lrow function is used to find the last populated row from column A - allowing the code to create a dynamically sized array and dictionary.

To enable use of dictionaries within VBA, you will need to go to Tools -> References and then enable Microsoft Scripting Runtime.

Sub createDictionary()    Dim dict As Scripting.Dictionary    Dim arrData() As Variant    Dim i as Long    arrData = Range("A1", Cells(lrow(1), 2))    set dict = new Scripting.Dictionary            For i = LBound(arrData, 1) To UBound(arrData, 1)        dict(arrData(i, 1)) = arrData(i, 2)    Next iEnd SubFunction lrow(ByVal colNum As Long) As Long    lrow = Cells(Rows.Count, 1).End(xlUp).RowEnd Function