Aggregating hourly location data into daily sublocation data for many columns

Question

I start with an hourly table that has around 40 of items (example: bread, barley, bagels, beef, chicken). The purpose of my code is to aggregate this hourly table's numbers to daily numbers but broken out by a sublocation or "type". My only way to allocate to type is to use a table that shows the % breakdown of type to location. This table, however, is at the Monthly day/night (Timeframe) granularity. I solved the problem with a dictionary for each item, but extending this out makes me believe I am doing this inefficiently.

I could use some opinions on how to better organize my code to handle dozens of items. A forewarning that I have never used collections or classes out of ignorance, but I am open to anything.

*note: I converted these tables in markdown format using this site

Hourly Table Example (~700,000 rows, ~40 columns to aggregate) <Pasted into B5>

Day	Location	Hour	Timeframe	bread	barley	bagels	beef	chicken
4/1/2021	A	0	night	51	91	12	26	176
4/1/2021	A	1	night	51	24	4	43	17
4/1/2021	A	8	day	25	84	5	72	125
4/1/2021	A	14	day	32	10	7	7	166
4/2/2021	A	0	night	31	29	11	49	5
4/2/2021	A	1	night	25	25	3	40	175
4/2/2021	A	8	day	70	81	6	69	89
4/2/2021	A	14	day	83	45	2	9	141
4/1/2021	B	0	night	55	37	8	59	164
4/1/2021	B	1	night	53	88	12	50	74
4/1/2021	B	8	day	20	73	1	33	200
4/1/2021	B	14	day	6	33	7	2	191
4/2/2021	B	0	night	39	52	4	22	99
4/2/2021	B	1	night	19	80	6	55	0
4/2/2021	B	8	day	44	49	10	42	8
4/2/2021	B	14	day	72	11	3	54	44

Here is a Monthly table that will be used to breakout daily numbers. There relationship between item-to-multiplier is one-to-many so in this example, bread, barley, and bagels are broken out by multiplier1, while beef and chicken are broken out by multiplier2. These breakouts are actually at the timeframe level so must occur before the day has been aggregated.

BREAKOUT TABLE Monthly Location with % of total listed by Type+Timeframe <Pasted in L5>

Month	Location	type	Timeframe	Multiplier1	Multiplier2
4/1/2021	A	x	day	16%	8%
4/1/2021	A	y	day	84%	92%
4/1/2021	A	x	night	33%	25%
4/1/2021	A	y	night	67%	75%
4/1/2021	B	x	day	50%	42%
4/1/2021	B	y	day	50%	58%
4/1/2021	B	x	night	100%	92%
4/1/2021	B	y	night	0%	8%
5/1/2021	A	x	day	26%	17%
5/1/2021	A	y	day	74%	83%
5/1/2021	A	x	night	51%	43%
5/1/2021	A	y	night	49%	57%
5/1/2021	B	x	day	1%	4%
5/1/2021	B	y	day	99%	96%
5/1/2021	B	x	night	2%	5%
5/1/2021	B	y	night	98%	95%

Here is the resulting intended table:

DAILY TABLE Day+Location+Type <Pasted in S5>

Day	Location	type	bread	barley	bagels	beef	chicken
4/1/2021	A	x	42.78	52.99	7.2	23.57	71.53
4/2/2021	A	x	42.96	37.98	5.9	28.49	63.4
4/1/2021	B	x	121	178	24	114.98	383.18
4/2/2021	B	x	116	162	16.5	111.16	112.92
4/1/2021	A	y	116.22	156.01	20.8	124.43	412.47
4/2/2021	A	y	166.04	142.02	16.1	138.51	346.6
4/1/2021	B	y	13	53	4	29.02	245.82
4/2/2021	B	y	58	30	6.5	61.84	38.08

And here is my current working code. Please let me know your thoughts and spare no criticism (I know I'm naming variables inconsistently).

Sub hourly_timeframe_to_day_type()
 ' Aggregate a table at the hourly+location+timeframe level
 ' to the daily+location+type level
 
 ' requires "Microsoft Scripting Runtime" reference enabled (Tools>References) to scripting.dictionary objects
 
 '-----------------------------------------------------
 ' Save the table with multipliers and save column header references
 '-----------------------------------------------------
 Dim breakout_array As Variant: breakout_array = ThisWorkbook.Worksheets(1).Range("L5").CurrentRegion
 With Application
 Dim breakout_month_col As Long: breakout_month_col = .Match("Month", .Index(breakout_array, 1, 0), 0)
 Dim breakout_location_col As Long: breakout_location_col = .Match("Location", .Index(breakout_array, 1, 0), 0)
 Dim breakout_type_col As Long: breakout_type_col = .Match("type", .Index(breakout_array, 1, 0), 0)
 Dim breakout_timeframe_col As Long: breakout_timeframe_col = .Match("Timeframe", .Index(breakout_array, 1, 0), 0)
 Dim breakout_multiplier1_col As Long: breakout_multiplier1_col = .Match("Multiplier1", .Index(breakout_array, 1, 0), 0)
 Dim breakout_multiplier2_col As Long: breakout_multiplier2_col = .Match("Multiplier2", .Index(breakout_array, 1, 0), 0)
 End With
 '-----------------------------------------------------
 ' Create dictionaries to track the multiplier using the column references
 '-----------------------------------------------------
 Dim MonthLocationTimeframeType_Multiplier1_dict As Scripting.Dictionary
 Set MonthLocationTimeframeType_Multiplier1_dict = CreateObject("Scripting.Dictionary")
 
 Dim MonthLocationTimeframeType_Multiplier2_dict As Scripting.Dictionary
 Set MonthLocationTimeframeType_Multiplier2_dict = CreateObject("Scripting.Dictionary")
 
 Dim types As Scripting.Dictionary: Set types = CreateObject("Scripting.Dictionary")
 Dim i As Long
 For i = 2 To UBound(breakout_array, 1)
 ' Month + Location + Type + Timeframe
 ' 4/1/2021 + A + x + day
 multiplierkeystring = _
 breakout_array(i, breakout_month_col) & _
 breakout_array(i, breakout_location_col) & _
 breakout_array(i, breakout_type_col) & _
 breakout_array(i, breakout_timeframe_col)
 
 MonthLocationTimeframeType_Multiplier1_dict(multiplierkeystring) = breakout_array(i, breakout_multiplier1_col)
 MonthLocationTimeframeType_Multiplier2_dict(multiplierkeystring) = breakout_array(i, breakout_multiplier2_col)
 ' list of possible types
 types(breakout_array(i, breakout_type_col)) = 1
 Next i
 Dim hrly_array As Variant: hrly_array = ThisWorkbook.Worksheets(1).Range("B5").CurrentRegion
 With Application
 'Dim hrly_month_col As Long: hrly_month_col = .Match("Month", .Index(hrly_array, 1, 0), 0)
 Dim hrly_location_col As Long: hrly_location_col = .Match("Location", .Index(hrly_array, 1, 0), 0)
 Dim hrly_timeframe_col As Long: hrly_timeframe_col = .Match("Timeframe", .Index(hrly_array, 1, 0), 0)
 Dim hrly_day_col As Long: hrly_day_col = .Match("Day", .Index(hrly_array, 1, 0), 0)
 
 Dim hrly_bread_col As Long: hrly_bread_col = .Match("bread", .Index(hrly_array, 1, 0), 0)
 Dim hrly_barley_col As Long: hrly_barley_col = .Match("barley", .Index(hrly_array, 1, 0), 0)
 Dim hrly_bagels_col As Long: hrly_bagels_col = .Match("bagels", .Index(hrly_array, 1, 0), 0)
 Dim hrly_beef_col As Long: hrly_beef_col = .Match("beef", .Index(hrly_array, 1, 0), 0)
 Dim hrly_chicken_col As Long: hrly_chicken_col = .Match("chicken", .Index(hrly_array, 1, 0), 0)
 ' ~40 more items
 End With
 Dim DayLocationType_bread_dict As Scripting.Dictionary: Set DayLocationType_bread_dict = CreateObject("Scripting.Dictionary")
 Dim DayLocationType_barley_dict As Scripting.Dictionary: Set DayLocationType_barley_dict = CreateObject("Scripting.Dictionary")
 Dim DayLocationType_bagels_dict As Scripting.Dictionary: Set DayLocationType_bagels_dict = CreateObject("Scripting.Dictionary")
 Dim DayLocationType_beef_dict As Scripting.Dictionary: Set DayLocationType_beef_dict = CreateObject("Scripting.Dictionary")
 Dim DayLocationType_chicken_dict As Scripting.Dictionary: Set DayLocationType_chicken_dict = CreateObject("Scripting.Dictionary")
 ' ~40 more items
 
 ' the first few columns
 Dim day_dict As Scripting.Dictionary: Set day_dict = CreateObject("Scripting.Dictionary")
 Dim location_dict As Scripting.Dictionary: Set location_dict = CreateObject("Scripting.Dictionary")
 Dim type_dict As Scripting.Dictionary: Set type_dict = CreateObject("Scripting.Dictionary")
 
 '-----------------------------------------------------
 ' Turn the hourly into daily type
 '-----------------------------------------------------
 Dim dailykeystring As String
 Dim possible_type As Variant
 
 For Each possible_type In types
 For i = 2 To UBound(hrly_array, 1) ' could be 700,000 rows
 ' define key strings
 multiplierkeystring = _
 DateSerial(Year(hrly_array(i, hrly_day_col)), Month(hrly_array(i, hrly_day_col)), 1) & _
 hrly_array(i, hrly_location_col) & _
 possible_type & _
 hrly_array(i, hrly_timeframe_col)
 dailykeystring = hrly_array(i, hrly_day_col) & hrly_array(i, hrly_location_col) & possible_type
 
 
 ' if this combination exists then continue
 ' and only need to check one dictionary since they all share the same key
 '-------------------------
 If MonthLocationTimeframeType_Multiplier1_dict.Exists(multiplierkeystring) Then
 
 '-------------------------
 ' Headers
 '-------------------------
 day_dict(dailykeystring) = hrly_array(i, hrly_day_col)
 location_dict(dailykeystring) = hrly_array(i, hrly_location_col)
 type_dict(dailykeystring) = possible_type
 '--------------------------------------------------
 ' Hourly+Location+Timeframe to Day+Location+Type
 '--------------------------------------------------
 
 If Not DayLocationType_bread_dict.Exists(dailykeystring) Then
 '------------------------------------------
 ' Start Aggregating
 '------------------------------------------
 
 ' Multipier1
 '-------------------------
 DayLocationType_bread_dict(dailykeystring) = hrly_array(i, hrly_bread_col) _
 * MonthLocationTimeframeType_Multiplier1_dict(multiplierkeystring)
 
 DayLocationType_barley_dict(dailykeystring) = hrly_array(i, hrly_barley_col) _
 * MonthLocationTimeframeType_Multiplier1_dict(multiplierkeystring)
 
 DayLocationType_bagels_dict(dailykeystring) = hrly_array(i, hrly_bagels_col) _
 * MonthLocationTimeframeType_Multiplier1_dict(multiplierkeystring)
 
 ' Multipier2
 '-------------------------
 DayLocationType_beef_dict(dailykeystring) = hrly_array(i, hrly_beef_col) _
 * MonthLocationTimeframeType_Multiplier2_dict(multiplierkeystring)
 
 DayLocationType_chicken_dict(dailykeystring) = hrly_array(i, hrly_chicken_col) _
 * MonthLocationTimeframeType_Multiplier2_dict(multiplierkeystring)
 
 ' ~40 more items
 Else
 '------------------------------------------
 ' Continue Aggregate
 '------------------------------------------
 
 ' Multiplier1
 '-------------------------
 DayLocationType_bread_dict(dailykeystring) = DayLocationType_bread_dict(dailykeystring) _
 + hrly_array(i, hrly_bread_col) * MonthLocationTimeframeType_Multiplier1_dict(multiplierkeystring)
 
 DayLocationType_barley_dict(dailykeystring) = DayLocationType_barley_dict(dailykeystring) _
 + hrly_array(i, hrly_barley_col) * MonthLocationTimeframeType_Multiplier1_dict(multiplierkeystring)
 DayLocationType_bagels_dict(dailykeystring) = DayLocationType_bagels_dict(dailykeystring) _
 + hrly_array(i, hrly_bagels_col) * MonthLocationTimeframeType_Multiplier1_dict(multiplierkeystring)
 
 ' Multiplier2
 '-------------------------
 DayLocationType_beef_dict(dailykeystring) = DayLocationType_beef_dict(dailykeystring) _
 + hrly_array(i, hrly_beef_col) * MonthLocationTimeframeType_Multiplier2_dict(multiplierkeystring)
 
 DayLocationType_chicken_dict(dailykeystring) = DayLocationType_chicken_dict(dailykeystring) _
 + hrly_array(i, hrly_chicken_col) * MonthLocationTimeframeType_Multiplier2_dict(multiplierkeystring)
 
 ' ~40 more items
 End If
 
 End If
 Next i
 Next possible_type
 '-----------------------------------------------------
 ' Print the Results
 '-----------------------------------------------------
 Dim daily_rows As Long: daily_rows = DayLocationType_bread_dict.Count
 
 With ThisWorkbook.Worksheets(1).Range("AC6")
 
 ' headers
 '-------------------------
 .Offset(0, 0).Resize(daily_rows, 1) = Application.Transpose(day_dict.Items)
 .Offset(0, 1).Resize(daily_rows, 1) = Application.Transpose(location_dict.Items)
 .Offset(0, 2).Resize(daily_rows, 1) = Application.Transpose(type_dict.Items)
 
 ' items
 '-------------------------
 .Offset(0, 3).Resize(daily_rows, 1) = Application.Transpose(DayLocationType_bread_dict.Items)
 .Offset(0, 4).Resize(daily_rows, 1) = Application.Transpose(DayLocationType_barley_dict.Items)
 .Offset(0, 5).Resize(daily_rows, 1) = Application.Transpose(DayLocationType_bagels_dict.Items)
 .Offset(0, 6).Resize(daily_rows, 1) = Application.Transpose(DayLocationType_beef_dict.Items)
 .Offset(0, 7).Resize(daily_rows, 1) = Application.Transpose(DayLocationType_chicken_dict.Items)
 
 ' ~40 more items
 '-------------------------
 
 End With
 
End Sub

• Greedo: Would you be open to suggestions about non-vba alternatives? For example, have you used pivot tables before - is there a reason you didn't use them for the aggregation? My initial thought would be to add some lookup columns to grab data from table 2 and put it in table 1, then use a pivot table on table 1 to aggregate it. Alternatively, powerquery would be a good tool for transforming and joining the two tables, have you come across this before? I generally avoid VBA for big data crunching as I think Excel has all the tools built in, and PQ is there for SQL levels of speed.
• Evan Friedland: Hi Greedo, thanks for the edit and the ideas. I use both but less often in my automated work. This is an end-step in a large process and I’m not sure how much legible and efficient either option would be in the rest of my project

Answer 1

Using a class to hold the data specific to the various items will help eliminate a lot of nearly duplicated code in your subroutine. The approach is that you define a class to hold data and objects relevant and unique to each item (bread, barely,chicken, etc). Doing so allows you to operate using loops.

So, a class like (TableItem) below:

 Option Explicit
 Private mBreakoutTableColumn As Long
 Private mResultOffsetColumn As Long
 Private mItemName As String
 Private mMultipliers As Dictionary
 Private myDict As Dictionary
 Private Sub Class_Initialize()
 Set myDict = New Dictionary
 End Sub
 Public Property Get DailyRowCount() As Long
 DailyRowCount = myDict.Count
 End Property
 Public Property Get ItemName() As String
 ItemName = mItemName
 End Property
 Public Property Let ItemName(ByVal RHS As String)
 mItemName = RHS
 End Property
 Public Property Get BreakoutTableColumn() As Long
 BreakoutTableColumn = mBreakoutTableColumn
 End Property
 Public Property Let BreakoutTableColumn(ByVal RHS As Long)
 mBreakoutTableColumn = RHS
 End Property
 Public Property Get ResultOffsetColumn() As Long
 ResultOffsetColumn = mResultOffsetColumn
 End Property
 Public Sub LoadUniqueContent(ByVal identifier As String, ByVal colNumber As Long, ByVal multipliers As Dictionary, ByVal rsltOffsetColumn As Long)
 ItemName = identifier
 BreakoutTableColumn = colNumber
 mResultOffsetColumn = rsltOffsetColumn
 Set mMultipliers = multipliers
 End Sub
 Public Function MultiplierKeyExists(ByVal multiplierKey As String) As Boolean
 MultiplierKeyExists = mMultipliers.Exists(multiplierKey)
 End Function
 Public Sub Aggregate(ByRef dailykeystring As String, ByRef multiplierkeystring As String, ByVal valToAggregate As Double)
 If Not myDict.Exists(dailykeystring) Then
 myDict(dailykeystring) = valToAggregate _
 * mMultipliers(multiplierkeystring)
 Else
 myDict(dailykeystring) = myDict(dailykeystring) + valToAggregate _
 * mMultipliers(multiplierkeystring)
 End If
 End Sub
 Public Function TransposeItem() As Variant
 TransposeItem = Application.Transpose(myDict.Items)
 End Function

Makes using loops possible. (Changes start about the middle of the subroutine)

 Option Explicit
 Sub hourly_timeframe_to_day_type()
 ' Aggregate a table at the hourly+location+timeframe level
 ' to the daily+location+type level
 
 ' requires "Microsoft Scripting Runtime" reference enabled (Tools>References) to scripting.dictionary objects
 
 '-----------------------------------------------------
 ' Save the table with multipliers and save column header references
 '-----------------------------------------------------
 
 'Dim breakout_array As Variant: breakout_array = ThisWorkbook.Worksheets("Breakout").Range("L5").CurrentRegion
 Dim breakout_array As Variant: breakout_array = ThisWorkbook.Worksheets("Breakout").Range("A1:F17")
 With Application
 Dim breakout_month_col As Long: breakout_month_col = .Match("Month", .Index(breakout_array, 1, 0), 0)
 Dim breakout_location_col As Long: breakout_location_col = .Match("Location", .Index(breakout_array, 1, 0), 0)
 Dim breakout_type_col As Long: breakout_type_col = .Match("type", .Index(breakout_array, 1, 0), 0)
 Dim breakout_timeframe_col As Long: breakout_timeframe_col = .Match("Timeframe", .Index(breakout_array, 1, 0), 0)
 Dim breakout_multiplier1_col As Long: breakout_multiplier1_col = .Match("Multiplier1", .Index(breakout_array, 1, 0), 0)
 Dim breakout_multiplier2_col As Long: breakout_multiplier2_col = .Match("Multiplier2", .Index(breakout_array, 1, 0), 0)
 End With
 '-----------------------------------------------------
 ' Create dictionaries to track the multiplier using the column references
 '-----------------------------------------------------
 Dim MonthLocationTimeframeType_Multiplier1_dict As Scripting.Dictionary
 Set MonthLocationTimeframeType_Multiplier1_dict = CreateObject("Scripting.Dictionary")
 
 Dim MonthLocationTimeframeType_Multiplier2_dict As Scripting.Dictionary
 Set MonthLocationTimeframeType_Multiplier2_dict = CreateObject("Scripting.Dictionary")
 
 Dim types As Scripting.Dictionary: Set types = CreateObject("Scripting.Dictionary")
 Dim multiplierkeystring As String
 
 Dim i As Long
 For i = 2 To UBound(breakout_array, 1)
 ' Month + Location + Type + Timeframe
 ' 4/1/2021 + A + x + day
 multiplierkeystring = _
 breakout_array(i, breakout_month_col) & _
 breakout_array(i, breakout_location_col) & _
 breakout_array(i, breakout_type_col) & _
 breakout_array(i, breakout_timeframe_col)
 
 MonthLocationTimeframeType_Multiplier1_dict(multiplierkeystring) = breakout_array(i, breakout_multiplier1_col)
 MonthLocationTimeframeType_Multiplier2_dict(multiplierkeystring) = breakout_array(i, breakout_multiplier2_col)
 ' list of possible types
 types(breakout_array(i, breakout_type_col)) = 1
 Next i
 
 
 '*******************************CHANGES START HERE**********************************
 'Load items into a collection
 Dim tblItems As Collection
 Set tblItems = New Collection
 
 'Dim hrly_array As Variant: hrly_array = ThisWorkbook.Worksheets(1).Range("B5").CurrentRegion
 Dim hrly_array As Variant: hrly_array = ThisWorkbook.Worksheets("Hourly").Range("A1:I17")
 With Application
 Dim hrly_location_col As Long: hrly_location_col = .Match("Location", .Index(hrly_array, 1, 0), 0)
 Dim hrly_timeframe_col As Long: hrly_timeframe_col = .Match("Timeframe", .Index(hrly_array, 1, 0), 0)
 Dim hrly_day_col As Long: hrly_day_col = .Match("Day", .Index(hrly_array, 1, 0), 0)
 End With
 
 'defaultTableItem is used for extracting data common to all items without having to access the collection
 Dim defaultTableItem As TableItem
 Set defaultTableItem = CreateTableItem("bread", hrly_array, MonthLocationTimeframeType_Multiplier1_dict, 3)
 tblItems.Add defaultTableItem
 
 Dim tblItem As TableItem
 Set tblItem = CreateTableItem("barley", hrly_array, MonthLocationTimeframeType_Multiplier1_dict, 4)
 tblItems.Add tblItem
 
 Set tblItem = CreateTableItem("bagels", hrly_array, MonthLocationTimeframeType_Multiplier1_dict, 5)
 tblItems.Add tblItem
 
 Set tblItem = CreateTableItem("beef", hrly_array, MonthLocationTimeframeType_Multiplier2_dict, 6)
 tblItems.Add tblItem
 
 Set tblItem = CreateTableItem("chicken", hrly_array, MonthLocationTimeframeType_Multiplier2_dict, 7)
 tblItems.Add tblItem
 ' ~40 more items
 
 'Dim DayLocationType_bread_dict As Scripting.Dictionary: Set DayLocationType_bread_dict = CreateObject("Scripting.Dictionary")
 'Dim DayLocationType_barley_dict As Scripting.Dictionary: Set DayLocationType_barley_dict = CreateObject("Scripting.Dictionary")
 'Dim DayLocationType_bagels_dict As Scripting.Dictionary: Set DayLocationType_bagels_dict = CreateObject("Scripting.Dictionary")
 'Dim DayLocationType_beef_dict As Scripting.Dictionary: Set DayLocationType_beef_dict = CreateObject("Scripting.Dictionary")
 'Dim DayLocationType_chicken_dict As Scripting.Dictionary: Set DayLocationType_chicken_dict = CreateObject("Scripting.Dictionary")
 ' ~40 more items REMOVED
 
 ' the first few columns
 Dim day_dict As Scripting.Dictionary: Set day_dict = CreateObject("Scripting.Dictionary")
 Dim location_dict As Scripting.Dictionary: Set location_dict = CreateObject("Scripting.Dictionary")
 Dim type_dict As Scripting.Dictionary: Set type_dict = CreateObject("Scripting.Dictionary")
 
 '-----------------------------------------------------
 ' Turn the hourly into daily type
 '-----------------------------------------------------
 Dim dailykeystring As String
 Dim possible_type As Variant
 
 For Each possible_type In types
 For i = 2 To UBound(hrly_array, 1) ' could be 700,000 rows
 ' define key strings
 multiplierkeystring = _
 DateSerial(Year(hrly_array(i, hrly_day_col)), Month(hrly_array(i, hrly_day_col)), 1) & _
 hrly_array(i, hrly_location_col) & _
 possible_type & _
 hrly_array(i, hrly_timeframe_col)
 dailykeystring = hrly_array(i, hrly_day_col) & hrly_array(i, hrly_location_col) & possible_type
 
 Aggregate tblItems, dailykeystring, multiplierkeystring, hrly_array, i
 '~40+ lines REMOVED
 
 ' if this combination exists then continue
 ' and only need to check one dictionary since they all share the same key
 '-------------------------
 If defaultTableItem.MultiplierKeyExists(multiplierkeystring) Then
 
 '-------------------------
 ' Headers
 '-------------------------
 day_dict(dailykeystring) = hrly_array(i, hrly_day_col)
 location_dict(dailykeystring) = hrly_array(i, hrly_location_col)
 type_dict(dailykeystring) = possible_type
 
 End If
 Next i
 Next possible_type
 '-----------------------------------------------------
 ' Print the Results
 '-----------------------------------------------------
 Dim daily_rows As Long
 daily_rows = defaultTableItem.DailyRowCount
 
 'With ThisWorkbook.Worksheets(1).Range("AC6")
 With ThisWorkbook.Worksheets("Daily").Range("A1")
 
 ' headers
 '-------------------------
 .Offset(0, 0).Resize(daily_rows, 1) = Application.Transpose(day_dict.Items)
 .Offset(0, 1).Resize(daily_rows, 1) = Application.Transpose(location_dict.Items)
 .Offset(0, 2).Resize(daily_rows, 1) = Application.Transpose(type_dict.Items)
 
 ' items ~40+ lines removed
 '-------------------------
 Dim tblItm As Variant
 For Each tblItm In tblItems
 Set tblItem = tblItm
 .Offset(0, tblItem.ResultOffsetColumn).Resize(daily_rows, 1) = tblItem.TransposeItem()
 Next
 End With
 
 End Sub
 Private Sub Aggregate(ByVal itemsCollection As Collection, ByVal dailykeystring As String, ByVal multiplierkeystring As String, ByRef hrlyArray As Variant, ByVal idx As Long)
 
 Dim tblItem As TableItem
 Dim itm As Variant
 For Each itm In itemsCollection
 Set tblItem = itm
 tblItem.Aggregate dailykeystring, multiplierkeystring, hrlyArray(idx, tblItem.BreakoutTableColumn)
 Next
 End Sub
 Private Function CreateTableItem(ByVal identifier As String, ByRef hrly_array As Variant, ByVal multipliers As Dictionary, ByVal rsltOffsetColumn As Long) As TableItem
 Dim tblItem As TableItem
 Set tblItem = New TableItem
 Dim breakoutCol As Long
 breakoutCol = Application.Match(identifier, Application.Index(hrly_array, 1, 0), 0)
 tblItem.LoadUniqueContent identifier, breakoutCol, multipliers, rsltOffsetColumn
 Set CreateTableItem = tblItem
 End Function

As you can see, the 40+ lines to configure each class instance are still needed. Once that is done, the code can operate on the Collection generically.