Add items to an array rather than replacing

Question

I have some code which uses arrays to get data from one worksheet (Cost Data) and essentially copy it to another worksheet (Compare Tool) in a side-by-side, comparison format. I got everything to work only to find out that in some cases, there are multiple lines of data on the Cost Data worksheet which meet the criteria. When these lines of data are assigned to my outarr array, it overwrites what was in there rather than adding to it.

I tried using the ReDim Preserve; however, I'm still getting an error. Any suggestions?

Sub Compare_Projects_Arrays()     
    Dim Toolary As Variant, Data_ary As Variant, PrjTitle_ary As Variant, CurrentAry As Variant, outarr As Variant
    Dim r As Long, nr As Long, x As Long, c As Long, CurrentCostCod As Long
    Dim Cl As Range
    Dim Project1 As String, Project2 As String, Project3 As String, Project4 As String, Project5 As String, Project6 As String, Project7 As String, Project8 As String
    
    Application.ScreenUpdating = False
    
        On Error Resume Next
            Sheets("Compare Tool").ShowAllData
            Sheets("Cost Data").ShowAllData
            Sheets("Compare Tool").Range("Clear_Cells").SpecialCells(xlConstants).ClearContents
            Sheets("Compare Tool").Range("AD15:AD16,AD19,AQ15:AD16,AQ19,BD15:BD16,BD19,BQ15:BQ16,BQ19,CD15:CD16, CD19,CQ15:CQ16, CQ19,DD15:DD16, DD19,DQ15:DQ16,DQ19").ClearContents
            Sheets("Compare Tool").Range("X23:DW24").ClearContents
        On Error GoTo 0
    
        With Sheets("Setup Page")
            Typology = .Range("L18")
            Project1 = .Range("U11").Value
            Project2 = .Range("U12").Value
            Project3 = .Range("U13").Value
            Project4 = .Range("U14").Value
            Project5 = .Range("U15").Value
            Project6 = .Range("U16").Value
            Project7 = .Range("U17").Value
            Project8 = .Range("U18").Value
        End With
        
        With Sheets("Compare Tool")
            Set SearchRangeTool = .Range("E:E").Find(What:="Last Row")
            LastRowTool = SearchRangeTool.Row
            
            If Project1 <> "" Then
                .Range("X23") = Project1
                .Range("X24") = "Typology: " & Typology
            End If
            If Project2 <> "" Then
                .Range("AK23") = Project2
                .Range("AK24") = "Typology: " & Typology
            End If
            If Project3 <> "" Then
                .Range("AX23") = Project3
                .Range("AX24") = "Typology: " & Typology
            End If
            If Project4 <> "" Then
                .Range("BK23") = Project4
                .Range("BK24") = "Typology: " & Typology
            End If
            If Project5 <> "" Then
                .Range("BX23") = Project5
                .Range("BX24") = "Typology: " & Typology
            End If
            If Project6 <> "" Then
                .Range("CK23") = Project6
                .Range("CK24") = "Typology: " & Typology
            End If
            If Project7 <> "" Then
                .Range("CX23") = Project7
                .Range("CX24") = "Typology: " & Typology
            End If
            If Project8 <> "" Then
                .Range("DK23") = Project8
                .Range("DK24") = "Typology: " & Typology
            End If
        End With
          
       'Put data into the arrarys (Toolary & Data_ary)
        Data_ary = Sheets("Cost Data").Range("A1").CurrentRegion.Value2
        
        With Sheets("Compare Tool")
            Toolary = .Range("A28:DV" & .Range("U" & Rows.Count).End(xlUp).Row).Value2
        End With
              
    'Project 1
        'Check if Project field is blank
        If Sheets("Setup Page").Range("U11") = "" Then GoTo Project2
        
        With Sheets("Cost Data")
            FirstRowDB = .Range("A:A").Find(What:=Project1, LookIn:=xlValues, SearchDirection:=xlNext).Row 'xlNext starts from top
            GSFPrj = .Cells(FirstRowDB, 13)
            GSFTypology = .Cells(FirstRowDB, 18)
        End With
         
         'Copy the GSF area & Total Project cost and paste into the top of the "Compare Tool" tab
        Sheets("Prj Info").Select
        FindPrj = Application.Match(Project1, Range("A:A"), 0)
        Total_Prj_Cost = Sheets("Prj Info").Cells(FindPrj, 16)
        Sheets("Compare Tool").Range("AD19") = GSFTypology
        Sheets("Compare Tool").Range("AD16") = GSFPrj
        Sheets("Compare Tool").Range("AD15") = Total_Prj_Cost
       
       
        lastrow = UBound(Toolary)
        outarr = Worksheets("Compare Tool").Range("X28:AI" & lastrow)
        
        'The following will put the formulas from the subtotals lines into the "toolfrom" array and then put it into the "outarr" array
        With Sheets("Compare Tool")
            toolfrom = .Range("X28:AI" & lastrow).formula
        End With
        For i = 1 To UBound(outarr, 1)
        For j = 1 To UBound(outarr, 2)
        If Left(toolfrom(i, j), 1) = "=" Then 'erroring out at i=1 and j=10
         outarr(i, j) = toolfrom(i, j)
        End If
        Next j
        Next i
       
        For r = 1 To lastrow
             If Toolary(r, 5) = "Single" Or Toolary(r, 5) = "T2 Head" Then
                CurrentCostCode = Toolary(r, 21)
                CurrentT0 = Toolary(r, 9)
    ReDim Preserve outarr(r) 'This is where the error happens
                     For x = 2 To UBound(Data_ary)
                         If Data_ary(x, 1) = Project1 And Data_ary(x, 34) = CurrentCostCode And Data_ary(x, 22) = CurrentT0 And Data_ary(x, 17) = Typology Then
                             outarr(r, 1) = Data_ary(x, 37) 'This is where the data is getting overwritten
                             outarr(r, 2) = Data_ary(x, 38) 'This is where the data is getting overwritten
                             outarr(r, 3) = Data_ary(x, 39) 'This is where the data is getting overwritten
                             outarr(r, 4) = Data_ary(x, 40) 'This is where the data is getting overwritten
                             outarr(r, 5) = Data_ary(x, 41) 'This is where the data is getting overwritten
                             outarr(r, 6) = Data_ary(x, 42) 'This is where the data is getting overwritten
                             outarr(r, 7) = Data_ary(x, 43) 'This is where the data is getting overwritten
                                 If Data_ary(x, 44) <> "" Then
                                     outarr(r, 8) = Data_ary(x, 44) 'This is where the data is getting overwritten
                                     outarr(r, 9) = Data_ary(x, 45) 'This is where the data is getting overwritten
                                 End If
                         End If
                     Next x
             End If
        Next r
        Worksheets("Compare Tool").Range("X28:AF" & lastrow) = outarr
    'Project 2
    Project2:
    
    
    Application.ScreenUpdating = True
    End Sub