Personally, I usually try to use the PT approach.
Here's a more better cleaned up version of the PT alternative if you're interested, better comments, squashed some bugs
Feel free to ask if my comment lines were not clear
Option Explicit
Sub test4()
Dim v As Variant
v = SumArray4(Worksheets("Inputs").Cells(1, 1).CurrentRegion)
MsgBox "Array (" & LBound(v, 1) & "-" & UBound(v, 1) & ", " & LBound(v, 2) & "-" & UBound(v, 2) & ")"
'puts array into the ws to check
Worksheets("Summary").Range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
End Sub
Function SumArray4(inInput As Range) As Variant
Dim ws1 As Worksheet, ws2 As Worksheet, wsIn As Worksheet
Dim rIn As Range
Dim r As Long, c As Long, o As Long
'remove old sheets just in case
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("temp1").Delete
Worksheets("temp2").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'add 2 temp sheets
Worksheets.Add
Set ws1 = ActiveSheet
ws1.Name = "temp1"
Worksheets.Add
Set ws2 = ActiveSheet
ws2.Name = "temp2"
'prep input data
Set rIn = inInput.CurrentRegion
Set wsIn = rIn.Parent
'make list for pivot table
o = 1
With ws1
.Cells(o, 1).Value = "Date"
.Cells(o, 2).Value = "Color"
.Cells(o, 3).Value = "Value"
o = o + 1
For r = 2 To rIn.Rows.Count
For c = 2 To rIn.Columns.Count
If rIn.Cells(r, c).Value > 0 Then
.Cells(o, 1).Value = rIn.Rows(r).EntireRow.Cells(1).Value
.Cells(o, 2).Value = rIn.Columns(c).EntireColumn.Cells(1).Value
.Cells(o, 3).Value = rIn.Cells(r, c).Value
o = o + 1
End If
Next c
Next r
'make pivot table
.Parent.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws1.Cells(1, 1).CurrentRegion, Version:=6). _
CreatePivotTable TableDestination:=ws2.Cells(1, 1), TableName:="PivotTable1", DefaultVersion:=6
End With
With ws2.PivotTables("PivotTable1")
.ColumnGrand = False
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = False
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
.CompactLayoutRowHeader = "Color"
.CompactLayoutColumnHeader = "Date"
With .PivotFields("Color")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Date")
.Orientation = xlColumnField
.Position = 1
End With
.AddDataField .PivotFields("Value"), "Sum of Value", xlSum
'return PT, skipping first row
SumArray4 = .TableRange1.Cells(2, 1).Resize(.TableRange1.Rows.Count - 1, .TableRange1.Columns.Count)
End With
'remove temp sheets
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("temp1").Delete
Worksheets("temp2").Delete
Application.DisplayAlerts = True
End Function