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

Question

I have a worksheet with data in columns A and B.

I am looking for a convenient way to take these columns and convert to a dictionary , where the cell in column A is the key and column B is the value , something like:

Dim dict as Dictionary Set dict = CreateDictFromColumns("SheetName", "A", "B") 

NOTE. I already refer to the dll script.

Answer 1

You will need a loop, for example.

 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 Next End Function 

This breaks down into the first cell of the empty cell value.

Answer 2

The best approach is to populate an array of options with data from the worksheet. Then you can iterate over the array, assigning the elements of the first column of the array as a dictionary key; as a value, then the elements of the second column of the array can be used.

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

To enable the use of dictionaries in VBA, you need to go to Tools → Links, and then enable the Microsoft Scripting Runtime executable.

 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 i End Sub Function lrow(ByVal colNum As Long) As Long lrow = Cells(Rows.Count, 1).End(xlUp).Row End Function 

Answer 3

I think that it would be a better form to pass two ranges into the function of the creation dictionary. This allows ranges to be completely separate, even different books. It also allows you to map a 1D range to a 2D range, as shown below.

Alternatively, you can also pass two arrays of range values. This may be cleaner for 1D ranges, but will result in more code for two-dimensional display. Note that the elements of the range can be looped by index from left to right from top to bottom. You can use Application.Transpose(Range("A1:A5")) to effectively run from top to bottom from left to right.

Cell mapping

 Sub Test() RangeToDict Sheets(1).Range("A1:A5"), Sheets(2).Range("C1:E2") End Sub Function 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 Next End Function 

Side-by-side (as a range)

If your target range is near two columns, you can simplify the transfer of one range, as shown below. Therefore, this also works to display any other element in the 1-dimensional range.

 Sub Test() RangeToDict2 Range("A1:B5") End Sub Function 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 Loop End Function 

Two columns (as an array)

Finally, as an example of passing arrays as arguments, you can do something like the following. However, the following code will only work with a specific OP script to map two columns. As with the case, it will not process display strings or variable elements.

 Sub Test() Dim Keys() As Variant: Keys = Range("E1:I1").Value2 Dim Values() As Variant: Values = Range("E3:I3").Value2 RangeToDict Keys, Values End Sub Function 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) Next End Function 

Using name ranges

It may be convenient to use named ranges, in which case you can pass a range, since the argument likes this ...

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

Answer 4

This should do the trick:

 Public Function test_leora(SheetName As String, _ KeyColumn As String, _ ValColumn As String) _ As Variant Dim Dic, _ Val As String, _ Key As String, _ Ws As Worksheet, _ LastRow As Long Set Ws = ThisWorkbook.Sheets(SheetName) Set Dic = CreateObject("Scripting.Dictionary") With Ws LastRow = .Range(KeyColumn & .Rows.Count).End(xlUp).Row For i = 1 To LastRow Val = .Cells(i, ValColumn) Key = .Cells(i, KeyColumn) If Dic.exists(Key) Then Else Dic.Add Val, Key End If Next i End With test_leora = Dic End Function