Excel data to a dictionary using VBA - excel

Question

For example, I have some data in an excel sheet 'MySheet' as follows:
sepal
petal
5
11
4
12
3
13
I need to convert these data into a dictionary follows after calling a VBA function named dict= ex_dict () where I can access to each key like :
dict=ex_dict(A1:B4)
dict= {"sepal": [5,4,3], "petal": [11,12,13]}
Or
dict ('sepal')= [5,4,3]
Initially, I thought I have found a solution. But later I have found that given solutions are output as string but not as Dictionary object

Answer 1

Columns to String
Function ex_dict(ByVal rg As Range) As String
Dim rCount As Long: rCount = rg.Rows.Count
If rCount < 2 Then Exit Function
ex_dict = "{"
Dim crg As Range
Dim r As Long
For Each crg In rg.Columns
ex_dict = ex_dict & """" & crg.Cells(1).Value & """: ["
For r = 2 To rCount
ex_dict = ex_dict & crg.Cells(r).Value & ","
Next r
ex_dict = Left(ex_dict, Len(ex_dict) - 1) & "], "
Next crg
ex_dict = Left(ex_dict, Len(ex_dict) - 2) & "}"
End Function

Answer 2

Please, use the next function:
Function ex_dictX(rng As Range) As String
Dim dict As Object, i As Long, j As Long, arr, strIt As String
Set dict = CreateObject("Scripting.Dictionary")
arr = rng.Value2: strIt = "["
For i = 1 To UBound(arr, 2)
For j = 2 To UBound(arr)
strIt = strIt & arr(j, i) & ","
Next j
dict.Add Chr(34) & arr(1, i) & Chr(34) & ": ", left(strIt, Len(strIt) - 1) & "]"
strIt = "["
Next i
'build the string to be returned (as pseudo dictionary):
For i = 0 To dict.count - 1
strIt = strIt & dict.Keys()(i) & dict.items()(i) & ", "
Next
ex_dictX = "{" & left(strIt, Len(strIt) - 2) & "}"
End Function
It can be tested with a simple Sub:
Sub tesTex_dict()
Debug.Print ex_dict(Range("A1:B4"))
End Sub
or call it as UDF (User Defined Function) from a cell as:
=ex_dict(A1:B4)
Edited:
Please, test the next version which returns a Scripting.Dictionary:
Function ex_dictD(rng As Range) As Object
Dim dict As Object, i As Long, j As Long, arr, strIt As String
Set dict = CreateObject("Scripting.Dictionary")
arr = rng.Value2: strIt = "["
For i = 1 To UBound(arr, 2)
For j = 2 To UBound(arr)
strIt = strIt & arr(j, i) & ","
Next j
dict.Add Chr(34) & arr(1, i) & Chr(34), left(strIt, Len(strIt) - 1) & "]"
strIt = "["
Next i
Set ex_dictD = dict
End Function
It can be tested in a Sub like the following one:
Sub testEx_dict()
Dim dict As Object, i As Long
Set dict = ex_dictD(Range("A1:C4"))
For i = 0 To dict.count - 1
Debug.Print dict.Keys()(i) & " = " & dict.items()(i)
Next
End Sub

Answer 3

Using the Dictionary Object.
Sub Example()
'Create a Dictionary object
Dim sepal As Object
Set sepal = CreateObject("Scripting.Dictionary")
'Loop through the table
Dim Cell As Range
For Each Cell In Range("A2:A5")
'Add unique entries to the dictionary
If Not sepal.exists(Cell.Value) Then
'Add cell value as the Key & the adjacent value as the Item.
sepal.Add Cell.Value, Cell.Offset(, 1).Value
End If
Next
Debug.Print sepal(4) 'returns 12
Debug.Print sepal(3) 'returns 13
End Sub
After building the dictionary, sepal.Keys returns the array [5,4,3] and sepal.Items returns the array [11,12,13].