match / manipulate arrays then paste back onto sheet

Hi all,

I am trying to consolidate unique data from 3 different excel files based on certain criteria (units bought > 0).

To illustrate things better, I have mocked up a sample file with 3 Buy sheets that represent the 3 excel files. All of them have the same number of columns/ column names / range names etc., so there's 100% consistency. Now there's 3 people maintaining these three files and putting in the Materials they want to buy and the number of units per region as well as an "x" in the cluster section to indicate where the item should be send to.

Now, Buyer 1 might buy Material XYZ but only for Japan and Buyer 2 also buys the exact same Material for Korea, hence the sheet "Total" should only paste the Material once and put the correct "x"s and units in each of the regions as found in these 3 files.

Also, only columns in my range "PasteArea" should be filled with the data from the other files, every other column contains a formula and should be calculated automatically...

Below code gives me exactly the output I need, but it is running incredibly slow as it does it cell by cell. I need someone's help to use jagged arrays or scripting dictionaries instead to manipulate the data first before pasting it back onto the sheet

Option Explicit
Sub PasteBuys()
        
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        
        'clear contents first
        ThisWorkbook.Sheets("TOTAL").Range("PasteArea").ClearContents
        
        Dim RngAddress As String
        With ThisWorkbook.Sheets("TOTAL")
            RngAddress = .Range(.Cells(.Range("Attribute_Material").Row, 1), .Cells(.Range("Attribute_Material").Row + .Range("Attribute_Material").Rows.Count - 1, .Cells(.Range("Attribute_Material").Row - 1, 1).End(xlToRight).Column)).Address
        End With
        
        Dim HeaderRow As Range
        Set HeaderRow = Range(RngAddress).Offset(-1).Resize(1)
        
        Dim Rng As Range
        Set Rng = ThisWorkbook.Sheets("TOTAL").Range(ThisWorkbook.Sheets("TOTAL").Cells(12, 1), ThisWorkbook.Sheets("TOTAL").Cells(12, ThisWorkbook.Sheets("TOTAL").Cells(12, 1).End(xlToRight).Column))
        
        'define relevant columns
        Dim arrCol() As Long
        ReDim arrCol(1 To Rng.Columns.Count)
        Dim a As Variant
        For Each a In ThisWorkbook.Sheets("TOTAL").Range("PasteArea").Areas
            Dim FCol As Long
            Dim LCol As Long
            FCol = a.Column
            LCol = FCol + a.Columns.Count - 1
            Dim c As Long
            For c = 1 To Rng.Columns.Count
                If HeaderRow.Column - 1 + c <= LCol And HeaderRow.Column - 1 + c >= FCol Then
                    Dim ColCnt As Long
                    ColCnt = ColCnt + 1
                    arrCol(ColCnt) = HeaderRow.Column - 1 + c
                End If
            Next c
        Next a
        ReDim Preserve arrCol(1 To ColCnt)
        
        Dim SubDiv As Variant
        SubDiv = Array("Buy 1", "Buy 2", "Buy 3")
        
        Dim r As Long
        For r = LBound(SubDiv) To UBound(SubDiv)
            
            Dim DataSet As Range
            Set DataSet = ThisWorkbook.Sheets(SubDiv(r)).Range(RngAddress)
            
            Dim DataValues As Variant
            DataValues = DataSet.Value
             
            Dim JPN As Long
            JPN = ThisWorkbook.Sheets("TOTAL").Range("Metric_JPN_TTL_UNT").Column - HeaderRow.Column + 1
    
            Dim KOR As Long
            KOR = ThisWorkbook.Sheets("TOTAL").Range("Metric_KOR_TTL_UNT").Column - HeaderRow.Column + 1
    
            Dim HMT As Long
            HMT = ThisWorkbook.Sheets("TOTAL").Range("Metric_HMT_TTL_UNT").Column - HeaderRow.Column + 1
    
            Dim CHN As Long
            CHN = ThisWorkbook.Sheets("TOTAL").Range("Metric_CHN_TTL_UNT").Column - HeaderRow.Column + 1
    
            Dim SEA As Long
            SEA = ThisWorkbook.Sheets("TOTAL").Range("Metric_SEA_TTL_UNT").Column - HeaderRow.Column + 1
    
            Dim ANZ As Long
            ANZ = ThisWorkbook.Sheets("TOTAL").Range("Metric_ANZ_TTL_UNT").Column - HeaderRow.Column + 1
            
            Dim arrOut()
            Dim i As Long
            Dim j As Long
            Dim cnt As Long
                
            ReDim arrOut(1 To UBound(DataValues), 1 To UBound(DataValues, 2))
                
            For i = LBound(DataValues) To UBound(DataValues)
                
                If (DataValues(i, JPN) + DataValues(i, KOR) + DataValues(i, HMT) + DataValues(i, CHN) + DataValues(i, SEA) + DataValues(i, ANZ)) <> 0 And IsEmpty(DataValues(i, 4)) = False Then
                    cnt = cnt + 1
                    For j = LBound(DataValues, 2) To UBound(DataValues, 2)
                        arrOut(cnt, j) = DataValues(i, j)
                    Next j
                End If
                    
            Next i
            
            If cnt <> 0 Then
                        
                For i = 1 To cnt
                    
                    On Error Resume Next
                    Dim MtchRw As Long
                    MtchRw = Application.Match(arrOut(i, 4), ThisWorkbook.Sheets("TOTAL").Range("Attribute_Material"), 0)
                    If Err.Number <> 0 Then MtchRw = 0
                    Err.Clear
                    On Error GoTo 0
                    
                    If IsEmpty(ThisWorkbook.Sheets("TOTAL").Cells(13, 4).Value) = True Then
                        Dim LstRw As Long
                        LstRw = 13
                    Else
                        LstRw = ThisWorkbook.Sheets("TOTAL").Cells(12, 4).End(xlDown).Row + 1
                    End If
                       
                    For c = LBound(arrCol) To UBound(arrCol)

                        If MtchRw <> 0 Then
                            Dim CelCont As Variant
                            CelCont = ThisWorkbook.Sheets("TOTAL").Cells(MtchRw + 12, arrCol(c)).Value
                            If IsError(CelCont) = False Then
                                If CelCont = " - " Or IsEmpty(CelCont) = True Or CelCont = 0 Then
                                    ThisWorkbook.Sheets("TOTAL").Cells(MtchRw + 12, arrCol(c)).Value = Application.Index(arrOut, i, arrCol(c))
                                End If
                            End If
                        Else
                            ThisWorkbook.Sheets("TOTAL").Cells(LstRw, arrCol(c)).Value = Application.Index(arrOut, i, arrCol(c))
                        End If
                    
                    Next c
                        
                Next i
                        
            End If
    
            cnt = 0
            
        Next r
        
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True

End Sub