Writing large (~89,000 elements) array to range - excel

Question

After populating my arrays based on some criteria I am attempting to write two temporary arrays to two different ranges on the worksheet. Using my current method with the transposed arrays I begin to get #N/A values after row 24,392. I'm not sure how to get past the size limitations of Application.Transpose.
LastRowA and LastRowB are declared globally as long. The value of LastRowA is >11,000 and LastRowB is >80,000
Sub Test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'call subs to find last rows for each sheet
LastRowASub
LastRowBSub
Dim i As Long
Dim j As Long
Dim x As Double
Dim y As Double
Dim Arr1() As Variant
Dim Arr2() As Variant
Dim Temp1() As String
Dim Temp2() As String
ReDim Arr1(1 To LastRowA - 1, 3)
ReDim Arr2(1 To LastRowB - 1)
ReDim Temp1(1 To LastRowB - 1)
ReDim Temp2(1 To LastRowB - 1)
'populate first array
For x = 1 To LastRowA - 1
Arr1(x, 1) = sheet1.Range("k" & x + 1)
Arr1(x, 2) = sheet1.Range("c" & x + 1)
Arr1(x, 3) = sheet1.Range("a" & x + 1)
Next x
'populate second array
For y = 1 To LastRowB - 1
Arr2(y, 1) = sheet2.Range("f" & y + 1)
Next y
'populate two temporary arrays based on matching between arrays 1 and 2
For i = 1 To UBound(Arr2)
For j = 1 To UBound(Arr1)
If Arr1(j, 1) = Arr2(i, 1) And Not IsEmpty(Arr1(j, 2)) Then
Temp1(i) = Arr1(j, 2)
Temp2(i) = Arr1(j, 3)
End If
Next j
Next i
'write temp arrays to sheet2
sheet2.Range("C2:C" & ExtLRow) = Application.Transpose(Temp1)
sheet2.Range("G2:G" & ExtLRow) = Application.Transpose(Temp2)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Everything is working as expected other than the transposed arrays returning #N/A.

Answer 1

Make the arrays 2 dimensional with one column:
ReDim Temp1(1 To LastRowB - 1,1 to 1)
ReDim Temp1(1 To LastRowB - 1,1 to 1)
Then when you assign the values:
Temp1(i,1) = Arr1(j, 2)
Temp2(i,1) = Arr1(j, 3)
Then you do not need the Application.Transpose
sheet2.Range("C2:C" & ExtLRow) = Temp1
sheet2.Range("G2:G" & ExtLRow) = Temp2
Also to speed things up avoid the loops altogether:
Sub Test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'call subs to find last rows for each sheet
LastRowASub
LastRowBSub
Dim i As Long
Dim j As Long
Dim x As Double
Dim y As Double
Dim Arr1() As Variant
Dim Arr2() As Variant
Dim Temp1() As Variant
Dim Temp2() As Variant
ReDim Temp1(1 To LastRowB - 1, 1 To 1)
ReDim Temp2(1 To LastRowB - 1, 1 To 1)
'populate first array
Arr1 = Sheet1.Range("A2:K" & lastrowa).Value
'populate second array
Arr2 = sheet2.Range("F2:F" & LastRowB).Value
'populate two temporary arrays based on matching between arrays 1 and 2
For i = 1 To UBound(Arr2, 1)
For j = 1 To UBound(Arr1, 1)
If Arr1(j, 11) = Arr2(i, 1) And Not IsEmpty(Arr1(j, 3)) Then
Temp1(i, 1) = Arr1(j, 3)
Temp2(i, 1) = Arr1(j, 1)
End If
Next j
Next i
'write temp arrays to sheet2
sheet2.Range("C2:C" & ExtLRow).Value = Temp1
sheet2.Range("G2:G" & ExtLRow).Value = Temp2
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub