Creating dictionary of dictionary of arrays

Question

My input file (flat text file) is as follows:

tom:ss1:ts1
dick:ss1:ts1
tom:ss2:ts2
dick:ss2:ts2
harry:ss1:ts1
tom:ss3:
harry::ts2

First col is employee name. Second col is softskill training and third is techskill training.

I want to read this file and create following structure "in memory" for being used in the later part of the code.

{
'dick': {
            'soft_skill': ['ss1', 'ss2'], 
            'tech_skill': ['ts1', 'ts2']
        }, 
'harry': {
            'soft_skill': ['ss1'], 
            'tech_skill': ['ts1', 'ts2']
        }, 
'tom': {
            'soft_skill': ['ss1', 'ss2', 'ss3'], 
            'tech_skill': ['ts1', 'ts2']
        }
}

Against the key 'tom' the value stored is a dictionary which is as below:

{
  'soft_skill': ['ss1', 'ss2', 'ss3'], 
  'tech_skill': ['ts1', 'ts2']
}

Inside this dictionary, against the key 'soft_skill', the value is an array which is shown as ['ss1', 'ss2', 'ss3'].

Similar to 'soft_skill', the key 'tech_skill' holds the value as an array shown as ['ts1', 'ts2'].

How to create above structure in VBA?

I have used FSO to read the text to excel and define a named range for col1 as "name_rng" which is continued with following:

Set traininglist = CreateObject("Scripting.Dictionary")
For Each cell In Range("name_rng")
   If Not traininglist.Exists(cell.Value) Then
      traininglist.Add cell.Value, Cells(cell.Row, 2).Value & ";" & _ 
         Cells(cell.Row, 3).Value
   Else
     traininglist(cell.Value) = traininglist(cell.Value) & "|" & _
     Cells(cell.Row, 2).Value & ";" & Cells(cell.Row, 3).Value
End If
Next
x = traininglist.keys
y = traininglist.items

For i = 0 To UBound(x)
    ActiveCell.Value = x(i)
    ActiveCell.Offset(0, 1).Value = y(i)
    ActiveCell.Offset(1, 0).Select
Next
Set traininglist = Nothing
end sub

This is how I have stored the values as (key,value) pair

tom => ss1;ts1|ss2;ts2|ss3;   

dick => ss1;ts1|ss2;ts2

harry => ss1;ts1|;ts2

For instance, taking the values of 'tom', 'ss1;ts1' is the first set of softskill and techskill which is then further delimited by | to segregate between the further sets of training for respective emp...

The above method is sufficing the need but I have to further split the values basis the delimiters and use loops to access the values... I Think this is a workaround but not a authenticate solution...

Thus need to advise on how to create dictionary of dictionary of arrays.

Jonathan Applebaum · Accepted Answer

It is possible to achieve that task using Data Types and arrays, please see my comments inside the code. but, if in spite of it you wish to use a Dictionary, you can use collection (or nested collections) as the value of the dictionary: Create dictionary of lists in vba

Type Employee
 soft_skill() As Variant
 tech_skill() As Variant
 name As String
End Type

Function GetEmployee(ByVal name As String, ByRef soft_skill As Variant, ByRef tech_skill As Variant) As Employee
GetEmployee.name = name
GetEmployee.soft_skill = soft_skill
GetEmployee.tech_skill = tech_skill
End Function


Sub Main()

' declare an array of 2 Employee for the example
Dim ar(1) As Employee

' add "TOM"
Dim soft_skill As Variant
soft_skill = Array("ss1", "ss2", "ss3")
Dim tech_skill As Variant
tech_skill = Array("ts1", "ts2")
ar(0) = GetEmployee("TOM", soft_skill, tech_skill)

' add "JOHN"
Dim soft_skill2 As Variant
soft_skill2 = Array("vb.net", "c++", "java")
Dim tech_skill2 As Variant
tech_skill2 = Array("c#", "vba")
ar(1) = GetEmployee("JOHN", soft_skill2, tech_skill2)

' loop trough the array
For i = 0 To UBound(ar)
MsgBox (ar(i).name & " ")
    ' show soft_skill
    For j = 0 To UBound(ar(i).soft_skill)
        MsgBox (ar(i).soft_skill(j))
    Next j
    ' show tech_skill
    For Z = 0 To UBound(ar(i).tech_skill)
        MsgBox (ar(i).tech_skill(Z))
    Next Z
Next i

' use like a dictionary (get TOM for example)
Dim p As Employee
p = pickEmp("TOM", ar)
' show tom name
MsgBox (p.name)
' show tom soft_skills
For i = 0 To UBound(p.soft_skill)
    MsgBox (p.soft_skill(i))
Next
' show tom tech_skill
For i = 0 To UBound(p.tech_skill)
    MsgBox (p.tech_skill(i))
Next

End Sub

' return employee by name parameter from employee array
Private Function pickEmp(ByVal name As String, ByRef empArray() As Employee) As Employee

   Dim index As Integer
   index = -1

    For i = 0 To UBound(empArray)
        If empArray(i).name = name Then
            index = i
            Exit For
        End If
    Next i

   If index = -1 Then
       MsgBox ("there is no employee called " & name)
   End If

    pickEmp = empArray(index)

End Function

Creating dictionary of dictionary of arrays

Answers (2)

Related Questions