Add items to an array rather than replacing - arrays

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