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

[Excel Fox]

Here's the revised code (actually, completely rebuilt)

Sub Condensor()

    Dim varSource As Variant
    Dim varMergers As Variant
    Dim sngYearQuarter As Single
    Dim lngMerger As Long
    Dim lngSource As Long
    Dim lngCol As Long
    Dim lngPullUpRow As Long
    Dim lngRowsReduced As Long
    With Worksheets("Sheet1")
        varSource = .Range("PortfolioTable").Value2
        varMergers = .Range("MergersTable").Value2
        sngYearQuarter = CSng(.Range("B2").Value & Application.DecimalSeparator & .Range("B1").Value)
        For lngMerger = LBound(varMergers) To UBound(varMergers)
            If sngYearQuarter = CSng(varMergers(lngMerger, 2) & Application.DecimalSeparator & varMergers(lngMerger, 1)) Then
                For lngSource = LBound(varSource) To UBound(varSource)
                    If varMergers(lngMerger, 3) = varSource(lngSource, 2) Then
                        varSource(lngSource, 2) = varMergers(lngMerger, 4)
                    End If
                Next lngSource
            End If
        Next lngMerger
        .Range("PortfolioTable").Value2 = varSource
        lngSource = .Range("PortfolioTable").Rows.Count
        For lngSource = lngSource To 2 Step -1
            For lngMerger = lngSource - 1 To 1 Step -1
                If varSource(lngSource, 2) = varSource(lngMerger, 2) Then
                    lngRowsReduced = lngRowsReduced + 1
                    For lngCol = 3 To 9
                        varSource(lngMerger, lngCol) = varSource(lngMerger, lngCol) + varSource(lngSource, lngCol)
                    Next lngCol
                    For lngPullUpRow = lngSource To .Range("PortfolioTable").Rows.Count - 1
                        For lngCol = 1 To 9
                            varSource(lngPullUpRow, lngCol) = varSource(lngPullUpRow + 1, lngCol)
                            varSource(lngPullUpRow + 1, lngCol) = Empty
                        Next lngCol
                    Next lngPullUpRow
                    
                End If
            Next lngMerger
        Next lngSource
        .Range("PortfolioTable").Value2 = varSource
        With .ListObjects("PortfolioTable")
            lngRowsReduced = .Range.Rows.Count - lngRowsReduced
            .Resize (.Range.Resize(lngRowsReduced))
        End With
    End With
    
End Sub