15 US Dollars For Macro To Merge And Aggregate Data For Same Row Headers

[Excel Fox]

I've just assumed that you are OK with replacing the output table. So here's the file with the revised code, and also the code below for posterity.

Option Explicit

Sub Consolidator()

    Dim varSource As Variant
    Dim varChanges As Variant
    Dim varOutput As Variant
    Dim sngYearQuarter As Single
    Dim wks As Worksheet
    Dim lngChanges As Long
    Dim lngSource As Long
    Dim lngOutput As Long
    Dim lstTable As ListObject
    Dim strPivotDataRange As String
    
    Application.ScreenUpdating = 0
    Set wks = Worksheets("Sheet1")
    With wks
        On Error Resume Next
        Set lstTable = .ListObjects("PortfolioTable2")
        Err.Clear: On Error GoTo 0: On Error GoTo -1
        If Not lstTable Is Nothing Then
            .Range("PortfolioTable2").EntireColumn.Delete
        End If
        .Range("PortfolioTable").Rows(1).Offset(-1).Resize(3).Copy .Range("P3")
        .ListObjects.Add(xlSrcRange, .Range("$P$3:$X$5"), , xlYes).Name = "PortfolioTable2"
        sngYearQuarter = .Range("B2").Value & "." & .Range("B1").Value
        varSource = .Range("PortfolioTable").Value2
        varChanges = .Range("MergersTable").Value2
        For lngChanges = LBound(varChanges) To UBound(varChanges)
            'Assuming that even if the Year and Quarter is greater than that in the mergers table, it still needs to be considered
            'If that's not the case, in the expression below, remove >= to =
            If sngYearQuarter >= CSng(varChanges(lngChanges, 2) & Application.DecimalSeparator & varChanges(lngChanges, 1)) Then
                For lngSource = LBound(varSource) To UBound(varSource)
                    If varSource(lngSource, 2) = varChanges(lngChanges, 3) Then
                        varSource(lngSource, 2) = varChanges(lngChanges, 4)
                    End If
                Next lngSource
            End If
        Next lngChanges
        .Range("P4").Resize(lngSource - 1, 9).Value = varSource
        .Range("AA:AI").Delete
        strPivotDataRange = CreatePiv
        .Range("PortfolioTable2").Offset(1).ClearContents
        .ListObjects("PortfolioTable2").Resize (.Range("PortfolioTable2").Rows(1).Offset(-1).Resize(2))
        .Range("P4").Resize(.Range(strPivotDataRange).Rows.Count, .Range(strPivotDataRange).Columns.Count).Value = .Range(strPivotDataRange).Value
        .Range(strPivotDataRange).EntireColumn.Delete
        .Range("PortfolioTable2").Rows(1).Resize(2).Copy
        .Range("PortfolioTable2").PasteSpecial Paste:=xlPasteFormats
        varOutput = .Range("PortfolioTable2").Value2
        Application.CutCopyMode = False
        For lngOutput = LBound(varOutput) To UBound(varOutput)
            If IsEmpty(varOutput(lngOutput, 1)) Then
                varOutput(lngOutput, 1) = varOutput(lngOutput - 1, 1)
            End If
        Next lngOutput
        .Range("PortfolioTable2").Value2 = varOutput
        .UsedRange.EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = 1
    
End Sub

Private Function CreatePiv() As String
    
    Dim pvc As PivotCache
    Dim pvt As PivotTable
    
    With ThisWorkbook
        Set pvc = .PivotCaches.Create(SourceType:=xlDatabase, SourceData:="PortfolioTable2", Version:=xlPivotTableVersion12)
        Set pvt = pvc.CreatePivotTable(TableDestination:="Sheet1!R2C27", TableName:="PvtCustom", DefaultVersion:=xlPivotTableVersion12)
    End With
    With pvt.PivotFields("Account")
        .Orientation = xlRowField
        .Position = 1
        .Subtotals(1) = False
    End With
    With pvt.PivotFields("Position")
        .Orientation = xlRowField
        .Position = 2
        .Subtotals(1) = False
    End With
    With pvt
        .AddDataField .PivotFields("Col3"), "Col_3", xlSum
        .AddDataField .PivotFields("Col4"), "Col_4", xlSum
        .AddDataField .PivotFields("Col5"), "Col_5", xlSum
        .AddDataField .PivotFields("Col6"), "Col_6", xlSum
        .AddDataField .PivotFields("Col7"), "Col_7", xlSum
        .AddDataField .PivotFields("Col8"), "Col_8", xlSum
        .AddDataField .PivotFields("Col9"), "Col_9", xlSum
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
        .ColumnGrand = False
        .RowGrand = False
        .ShowTableStyleColumnHeaders = False
        .ShowTableStyleRowHeaders = False
        CreatePiv = .TableRange1.Offset(.ColumnRange.Rows.Count).Resize(.TableRange1.Rows.Count - .ColumnRange.Rows.Count).Address
        'Same Thing
        'CreatePiv = .DataBodyRange.Offset(, -(.RowRange.Columns.Count)).Resize(, .DataBodyRange.Columns.Count + .RowRange.Columns.Count).Address
    End With
    
End Function