[VBA] Creating more than one dictionary?

[ScatmanKyle]

I have a database that I pull from a dashboard where I need to insert details into a separate file/format to check the accuracy of data.

A	B	C	D	E	F
Business	Campaign	Platform	Metric 1	Metric 2	Metric 3

Each unique "Business" has to have its own tab in the file. Within each business, the campaigns need to have a table set up that contain the platforms, then the metric data is pulled in.

So far I've managed to use the dictionary function to create the individual tabs (Test dict being the tab with the data):

Sub TabSetup()

'Creating the dictionary for Business
Dim dictLOB As Object
Dim rngLOB As Range
Dim lngLastRow As Long
Dim varTab As Variant

ThisWorkbook.Sheets("Test dict").Activate

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set dictLOB = CreateObject("Scripting.Dictionary")

For Each rngLOB In Range("A2:A" & lngLastRow)
    If Not dictLOB.exists(rngLOB.Value) Then dictLOB.Add rngLOB.Value, Nothing
Next

'MsgBox (dictLOB.Count & " distinct LOBs")

'Setting up tabs
For Each Key In dictLOB
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Key
Next

End Sub

At the moment, I'm stuck on how to:

1) Create a separate dictionary for the campaigns and for the platforms
2) Use a sumifs statement from dictionary variables (since the data I'm using has data for all of the businesses/campaigns/platforms).

 

[DanteAmor]

Try the following.
If you want to increase the number of metrics, change the 3 to the new number on this line:
ReDim b(1 To UBound(a, 1), 1 To 3)

Note: The macro assumes that the data is ordered by column A, B, and C in that sequence.

Copy all the code into a module and run the macro "TabSetup"

Option Explicit

Sub TabSetup()
  Dim sh As Worksheet
  Dim dic1 As Object, dic2 As Object, dic3 As Object
  Dim a As Variant, b As Variant, vls As Variant
  Dim ky1 As Variant, ky2 As Variant, ky3 As Variant
  Dim i As Long, j As Long, k As Long, n As Long, m As Long
  Dim ant1 As String, ant2 As String
  
  Application.ScreenUpdating = False
  Set sh = ThisWorkbook.Sheets("Test dict")
  a = sh.Range("A1:F" & sh.Range("A" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 3)
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  Set dic3 = CreateObject("Scripting.Dictionary")
  
  For i = 2 To UBound(a, 1)
    ky1 = a(i, 1)
    ky2 = a(i, 1) & "|" & a(i, 2)
    ky3 = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)
    If Not dic1.exists(ky1) Then
      dic1(ky1) = Empty
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = ky1
    End If
    
    If Not dic2.exists(ky2) Then
      dic2(ky2) = 0
    End If
    
    If Not dic3.exists(ky3) Then
      dic2(ky2) = dic2(ky2) + 1
      k = k + 1
      dic3(ky3) = k
    Else
      k = dic3(ky3)
    End If
    For j = 1 To UBound(b, 2)
      b(k, j) = b(k, j) + a(i, j + 3)
    Next
  Next
  
  ant1 = ""
  ant2 = ""
  For Each ky3 In dic3.keys
    vls = Split(ky3, "|")
    k = dic3(ky3)
    n = dic2(vls(0) & "|" & vls(1))
    If ant1 <> vls(0) Then
      i = 2
    Else
      i = i + 1
    End If
    If ant2 <> vls(1) Then
      If i > 2 Then
        i = i + 3
      End If
      Call FormatTable(vls, i, n, UBound(b, 2))
      i = i + 3
      m = i + n
    End If
    With Sheets(vls(0))
      .Range("A" & i).Value = vls(2)
      For j = 1 To UBound(b, 2)
        .Cells(i, j + 1).Value = b(k, j)
        .Cells(m, j + 1).Value = .Cells(m, j + 1).Value + b(k, j)
      Next
    End With
    ant1 = vls(0)
    ant2 = vls(1)
  Next
End Sub

Sub FormatTable(vls As Variant, i As Long, n As Long, j As Long)
  Dim k As Long
  With Sheets(vls(0))
    With .Range("A" & i)
      .Value = vls(1)
      .Interior.Color = vbBlack
      .Font.Color = vbWhite
      .Resize(1, 4).Merge
      .HorizontalAlignment = xlCenter
    End With
    With .Range("A" & i + 1)
      .Value = "SITE"
      .Resize(2, 1).Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Bold = True
    End With
    With .Range("B" & i + 1)
      .Value = "DASHBOARD"
      .Resize(1, 3).Merge
      .HorizontalAlignment = xlCenter
      .Font.Bold = True
    End With
    .Range("A" & i + 3 + n).Value = "Total"
    For k = 1 To j
      .Cells(i + 2, k + 1).Value = "M" & k
    Next
    .Range("B" & i + 1).Resize(2 + n, j).Interior.Color = 15853019
    .Range("A" & i).Resize(4 + n, j + 1).Borders.LineStyle = xlContinuous
  End With
End Sub