Creating dictionary of dictionary of arrays - vba

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.

Answer 1

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

Answer 2

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