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.

@tim find my effort.. have edited the question to add my effort... — mohanish, Jun 26 '17 at 02:25
@Mohanish... Good effort. If I understand correctly, the basic question here is: how to create the Type dynamically while reading the record from the file. — Sachin S, Jun 26 '17 at 04:56
@Sachin... thanks... yes you are right... glad that you understand the crux of the problem i am facing..... still waiting for the dynamic solution... — mohanish, Jun 26 '17 at 09:57

Jonathan Applebaum · Accepted Answer · 2017-06-25T22:56:31.597

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

thanks for the solution... but my file is unsorted and emp can repeat at any line of the table... how to make above solution dynamic to create the softskill and tech skill array for each emp at the runtime while reading unsorted file.... basically i want a solution which is linear..... adivse much appreciated... — mohanish, Jun 26 '17 at 02:36
@jonathana......thanks for throwing some light on 'Type' in vba... finally i am able to arrive at an dynamic solution after juggling through various approach.. i created array of dictionaries to store the training details....now trying to store the same creating dictionary of dictionaries..... — mohanish, Jun 28 '17 at 13:54

score 0 · Answer 2 · answered Jun 26 '17 at 22:28

Try the following macro...

Sub test()

Dim dicNames As Object
Dim dicSkills As Object
Dim strPathAndFilename As String
Dim strTextLine As String
Dim intFileNum As Integer
Dim arrData() As String
Dim strName As String
Dim strSoftSkill As String
Dim strTechSkill As String
Dim intField As Integer
Dim arr() As String
Dim i As Long

strPathAndFilename = "c:\users\domenic\desktop\sample.txt"
If Len(Dir(strPathAndFilename, vbNormal)) = 0 Then
    MsgBox "File not found.", vbExclamation
    Exit Sub
End If

Set dicNames = CreateObject("Scripting.Dictionary")
dicNames.CompareMode = 1 'TextCompare

intFileNum = FreeFile()
Open strPathAndFilename For Input As intFileNum
    Do Until EOF(intFileNum)
        Line Input #intFileNum, strTextLine
        If Len(strTextLine) > 0 Then
            strName = ""
            strSoftSkill = ""
            strTechSkill = ""
            arrData() = Split(strTextLine, ":")
            For intField = LBound(arrData) To UBound(arrData)
                Select Case intField
                    Case 0: strName = Trim(Split(strTextLine, ":")(intField))
                    Case 1: strSoftSkill = Trim(Split(strTextLine, ":")(intField))
                    Case 2: strTechSkill = Trim(Split(strTextLine, ":")(intField))
                End Select
            Next intField
            If Not dicNames.Exists(strName) Then
                Set dicSkills = CreateObject("Scripting.Dictionary")
                dicSkills.CompareMode = 1 'TextCompare
                If Len(strSoftSkill) > 0 Then
                    dicSkills.Add "Soft_Skills", strSoftSkill
                End If
                If Len(strTechSkill) > 0 Then
                    dicSkills.Add "Tech_Skills", strTechSkill
                End If
                dicNames.Add strName, dicSkills
            Else
                If Len(strSoftSkill) > 0 Then
                    dicNames(strName).Item("Soft_Skills") = dicNames(strName).Item("Soft_Skills") & "|" & strSoftSkill
                End If
                If Len(strTechSkill) > 0 Then
                    dicNames(strName).Item("Tech_Skills") = dicNames(strName).Item("Tech_Skills") & "|" & strTechSkill
                End If
            End If
        End If
    Loop
Close intFileNum

'List soft skills for Tom
arr() = Split(dicNames("tom").Item("Soft_Skills"), "|")
If UBound(arr) <> -1 Then
    For i = LBound(arr) To UBound(arr)
        Debug.Print Trim(arr(i))
    Next i
Else
    MsgBox "No soft skills listed for Tom.", vbInformation
End If

Set dicNames = Nothing
Set dicSkills = Nothing

End Sub

Creating dictionary of dictionary of arrays

2 Answers2