Using Arrays and Dictionaries Within Dictionaries

Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.

Each code block covered in the video is given below.

Arrays in a Dictionary

Sub TransformData()

wsOut.Range("A1") = "Region"

Dim arrIn() As Variant, arrOut() As Variant
Dim lrow As Long
lrow = wsIn.Range("A1").CurrentRegion.Rows.Count

arrIn = wsIn.Range("A2:B" & lrow).Value

Dim dicIn As Object
Set dicIn = CreateObject("Scripting.Dictionary")

Dim sStoreName As String, sRegion As String
Dim arrStoreName() As String
Dim i As Long
Dim arrLength As Long
For i = LBound(arrIn, 1) To UBound(arrIn, 1)
    sStoreName = arrIn(i, 1)
    sRegion = arrIn(i, 2)
    If Not dicIn.exists(sRegion) Then
        ReDim arrStoreName(1 To 1)
        arrStoreName(1) = sStoreName
        dicIn.Add Key:=sRegion, Item:=arrStoreName
        arrLength = UBound(dicIn(sRegion))
        ReDim arrStoreName(1 To arrLength)
        arrStoreName = dicIn(sRegion)
        ReDim Preserve arrStoreName(1 To arrLength + 1)
        arrStoreName(arrLength + 1) = sStoreName
        dicIn(sRegion) = arrStoreName
    End If
Next i

For i = 0 To dicIn.Count - 1
    wsOut.Cells(1, i + 2).Value = dicIn.keys()(i)
    arrLength = UBound(dicIn.items()(i))
    wsOut.Cells(2, i + 2).Resize(arrLength, 1).Value = Application.WorksheetFunction.Transpose( _
Next i

lrow = wsOut.Range("A1").CurrentRegion.Rows.Count
For i = 2 To lrow
           wsOut.Cells(i, 1).Value = "Store" & i - 1
Next i
End Sub

Dictionaries in a Dictionary

Sub TransformData()

Dim lrow As Long, lcol As Long
lrow = wsData.Range("A1").CurrentRegion.Rows.Count
lcol = wsData.Range("A1").CurrentRegion.Columns.Count

Dim dicRegion As Object
Set dicRegion = CreateObject("Scripting.Dictionary")

Dim dicStoreName As Object
Dim sStoreName As String, sRegion As String
Dim i As Long, j As Long
For i = 2 To lrow
    sRegion = wsData.Cells(i, 1).Value
    Set dicStoreName = CreateObject("Scripting.Dictionary")
    For j = 2 To lcol
        sStoreName = wsData.Cells(i, j).Value
        If sStoreName = "" Then Exit For
        dicStoreName.Add Key:=sStoreName, Item:=0
    Next j
    dicRegion.Add Key:=sRegion, Item:=dicStoreName
    Set dicStoreName = Nothing
Next i

lrow = wsInv.Range("A1").CurrentRegion.Rows.Count
For i = 2 To lrow
    sRegion = wsInv.Cells(i, 6).Value
    sStoreName = wsInv.Cells(i, 5).Value
    If dicRegion.exists(sRegion) Then
        Set dicStoreName = dicRegion(sRegion)
        If Not dicStoreName.exists(sStoreName) Then
            wsInv.Range(wsInv.Cells(i, 5), wsInv.Cells(i, 6)).Interior.ColorIndex = 3
        End If
        Set dicStoreName = Nothing
    End If
Next i

End Sub