Excel data to a dictionary using VBA

user_9539893 0
Viewed 182

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

vba excel dictionary
3 Answers

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
user_98140690

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
user_22333080

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].

user_146087500
Related