Can anyone tell me how to speed up this array?

[Ppessina]

I am dealing with roughly 17000 rows and 30 columns. I am relatively new to using arrays and despite all my research I dont feel like I have a firm enough grasp of them to tell whether the arrays in the code below are any good. the entire process takes about 45 seconds. I think it is getting hung up when I am reading back and forth with the sumif function. I know the code is long and probably does not make much sense without the workbook but I am really just looking for someone to tell me if there is something different I could do with the arrays that would be better. Thanks for the help.

Sub CreateSheetsWithNames()
       
     Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
       
Dim bcell As Range
Dim FirstRow As Range
Dim strnsearch As String
Dim lastcolumn1 As Long
Dim num As String
Dim num2 As String
Application.CutCopyMode = False
   
With Sheets("Master2")
lastcolumn1 = .Range("b1").End(xlToRight).Column 'last column in sheet
Set FirstRow = .Range(Cells(1, lastcolumn1).Address) 'first row of the last column
lrow = .Range("a" & .Rows.Count).End(xlUp).Row 'last row in column A

FirstRow.Offset(0, 1).Value = "AUTHORIZATIONS"
    hcellletter1 = Col_Letter(FirstRow.Offset(0, 1).Column)
    
FirstRow.Offset(0, 2).Value = "VOUCHERS"
     hcellletter2 = Col_Letter(FirstRow.Offset(0, 2).Column)
     
FirstRow.Offset(0, 3).Value = "LOCAL VOUCHERS"
     hcellletter3 = Col_Letter(FirstRow.Offset(0, 3).Column)
     
FirstRow.Offset(0, 4).Value = "Doc create date after departure date"
     hcellletter4 = Col_Letter(FirstRow.Offset(0, 4).Column)
     
FirstRow.Offset(0, 5).Value = "Travel Notice Given"
     hcellletter5 = Col_Letter(FirstRow.Offset(0, 5).Column)
     
FirstRow.Offset(0, 6).Value = "Voucher Create date over 5 days from Return"
     hcellletter6 = Col_Letter(FirstRow.Offset(0, 6).Column)
     
FirstRow.Offset(0, 7).Value = "Last AO approved Date before  Doc Create Date"
     hcellletter7 = Col_Letter(FirstRow.Offset(0, 7).Column)
     
FirstRow.Offset(0, 8).Value = "Is Cancelled Trip Zero'd Out?"
     hcellletter8 = Col_Letter(FirstRow.Offset(0, 8).Column)
     
  FirstRow.Offset(0, 9).Value = "Future Trip"
    hcellletter9 = Col_Letter(FirstRow.Offset(0, 9).Column)
         
FirstRow.Offset(0, 10).Value = "Unliquidated Amount"
     hcellletter10 = Col_Letter(FirstRow.Offset(0, 10).Column)
     
FirstRow.Offset(0, 11).Value = "Unliquidated %"
    hcellletter11 = Col_Letter(FirstRow.Offset(0, 11).Column)
 Range(FirstRow.Offset(0, 1), FirstRow.Offset(0, 11)).Font.Bold = True
       
strnsearch = "Document Type"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
 If Not bcell Is Nothing Then
    bcellletter0 = Col_Letter(bcell.Column)
         Else
            MsgBox ("Please designate column 'Document Type'")
                End
                    End If
                                   
strnsearch = "Expenses by LOA"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

If Not bcell Is Nothing Then
   bcellletter1 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Expenses by LOA'")
                 End
                    End If

strnsearch = "Document Create Date"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

If Not bcell Is Nothing Then
    bcellletter2 = Col_Letter(bcell.Column)
         Else
            MsgBox ("Please designate column 'Document Create Date'")
             End
                    End If

strnsearch = "Departure Date"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
            
    If Not bcell Is Nothing Then
    bcellletter3 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Departure Date'")
                 End
                    End If
                 
strnsearch = "Last AO Approved Date"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
           
  If Not bcell Is Nothing Then
    bcellletter4 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Last AO Approved Date'")
                 End
                    End If
       
strnsearch = "Total Trip Expenses"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
             
    If Not bcell Is Nothing Then
    bcellletter5 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Total Trip Expenses'")
                 End
                    End If
                       
strnsearch = "TANum"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
            
   If Not bcell Is Nothing Then
    bcellletter6 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'TANum'")
                 End
                    End If
                      
strnsearch = "Return Date"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

If Not bcell Is Nothing Then
    bcellletter7 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Return Date'")
                 End
                    End If

strnsearch = "Current Status"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
                                     
If Not bcell Is Nothing Then
    bcellletter8 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Current Status'")
                 End
                    End If
                    
     strnsearch = "LOA Label"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
                           
If Not bcell Is Nothing Then
    bcellletter9 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'LOA Label'")
                 End
                    End If
                    
Dim createA0 As Variant
Dim createA1 As Variant
Dim createA2 As Variant
Dim createA3 As Variant
Dim createA4 As Variant
Dim createA5 As Variant
Dim createA6 As Variant
Dim createA7 As Variant
Dim createA8 As Variant
Dim createA9 As Variant

createA0 = .Range(bcellletter0 & 1, .Range(bcellletter0 & lrow).Address) 'doc type
createA1 = .Range(bcellletter1 & 1, .Range(bcellletter1 & lrow).Address) 'expenses by loa
createA2 = .Range(bcellletter2 & 1, .Range(bcellletter2 & lrow).Address) 'create date
createA3 = .Range(bcellletter3 & 1, .Range(bcellletter3 & lrow).Address) 'departure date
createA4 = .Range(bcellletter4 & 1, .Range(bcellletter4 & lrow).Address) 'last ao approved date
createA5 = .Range(bcellletter5 & 1, .Range(bcellletter5 & lrow).Address) 'total trip expenses
createA6 = .Range(bcellletter6 & 1, .Range(bcellletter6 & lrow).Address) 'tanum
createA7 = .Range(bcellletter7 & 1, .Range(bcellletter7 & lrow).Address) 'return date
createA8 = .Range(bcellletter8 & 1, .Range(bcellletter8 & lrow).Address) 'current status
createA9 = .Range(bcellletter9 & 1, .Range(bcellletter9 & lrow).Address) 'loa label

For l = 2 To (UBound(createA0) - 1)
Dim rngarray() As Variant
ReDim Preserve rngarray(9, l)

   If UCase(createA0(l, 1)) = "AUTH" Then
    rngarray(0, l - 2) = createA1(l, 1)                             
    rngarray(1, l - 2) = createA3(l, 1) - createA2(l, 1)           
            End If

    If UCase(createA0(l, 1)) = "VCH" Then
    rngarray(2, l - 2) = createA1(l, 1)              
             End If
      
    If UCase(createA0(l, 1)) = "LVCH" Then
    rngarray(3, l - 2) = createA1(l, 1)                
             End If

    If UCase(createA0(l, 1)) = "AUTH" Then
    If createA2(l, 1) > createA3(l, 1) Then
    rngarray(4, l - 2) = "Error"                      
            End If
            End If

    If UCase(createA0(l, 1)) = "VCH" Then
    If (createA2(l, 1) - createA7(l, 1)) > 5 Then
    rngarray(5, l - 2) = "Error"                     
             End If
             End If

    If UCase(createA0(l, 1)) = "LVCH" Then
    If (createA2(l, 1) - createA7(l, 1)) > 5 Then
    If rngarray(5, l - 2) = "" Then
    rngarray(5, l - 2) = "Error"                      
            End If
            End If
            End If

    If createA1(l, 1) > 0 Then
    If UCase(createA8(l, 1)) = "CANCELLED" Then         
    rngarray(7, l - 2) = "Error"
            End If
            End If

    If createA6(l, 1) = "FLAGGED TANum" Then      
    rngarray(8, l - 2) = createA1(l, 1)
            End If

    If UCase(createA8(l, 1)) = "CANCELLED" Then           
    If createA6(l, 1) <> "FLAGGED TANum" Then
    If createA1(l, 1) <> 0 Then
    If rngarray(8, l - 2) = "" Then
    rngarray(8, l - 2) = createA1(l, 1)
            End If
            End If
            End If
            End If
                             
 If (Date - createA7(l, 1)) < 0 Then           
 rngarray(9, l - 2) = createA1(l, 1)
  End If
                
Next

Erase createA0
        Erase createA2
            Erase createA3
                Erase createA4
                    Erase createA5
                        Erase createA6
                            Erase createA7
                                Erase createA8
                                    Erase createA9
num2 = ""

createA0 = .Range(bcellletter0 & 1, .Range(bcellletter0 & lrow).Address)
For l = 2 To lrow
 On Error Resume Next

num = .Range("A" & l).Value
Dim numa()
ReDim Preserve numa(1, l)


If num <> num2 Then
If UCase(createA0(l, 1)) = "AUTH" Then
numa(0, l - 2) = WorksheetFunction.SumIf(.Range("a" & 2, .Range("a" & lrow).Address), .Range(.Cells(l, "a").Address), .Range(bcellletter1 & 2, .Range(bcellletter1 & lrow).Address))
numa(1, l - 2) = numa(0, l - 2) / WorksheetFunction.SumIfs(.Range(bcellletter1 & 2, .Range(bcellletter1 & lrow).Address), .Range("a" & 2, .Range("a" & lrow).Address), .Range(.Cells(l, "a").Address), .Range(bcellletter0 & 2, .Range(bcellletter0 & lrow).Address), UCase("AUTH"))
Else
numa(0, l - 2) = WorksheetFunction.SumIfs(.Range(bcellletter1 & 2, .Range(bcellletter1 & lrow).Address), .Range("a" & 2, .Range("a" & lrow).Address), .Range(.Cells(l, "a").Address), .Range(bcellletter0 & 2, .Range(bcellletter0 & lrow).Address), UCase("*VCH"))
If numa(0, l - 2) = 0 Then
numa(1, l - 2) = ""
Else
numa(1, l - 2) = "-100.00%"
End If

End If
End If

If num = num2 Then
If UCase(createA0(l, 1)) <> "AUTH" Then
If UCase(createA0(l, 1)) = "AUTH" Then
numa(0, l - 2) = WorksheetFunction.Round(WorksheetFunction.SumIf(.Range("a" & 2, .Range("a" & lrow).Address), .Range(.Cells(l, "a").Address), .Range(bcellletter1 & 2, .Range(bcellletter1 & lrow).Address)), 2)
numa(1, l - 2) = numa(0, l - 2) / WorksheetFunction.SumIfs(.Range(bcellletter1 & 2, .Range(bcellletter1 & lrow).Address), .Range("a" & 2, .Range("a" & lrow).Address), .Range(.Cells(l, "a").Address), .Range(bcellletter0 & 2, .Range(bcellletter0 & lrow).Address), UCase("AUTH"))
End If
End If
End If

num2 = num

If numa(0, l - 2) = 0 Then numa(0, l - 2) = ""


Next

.Range(hcellletter10 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(numa)
    .Range(hcellletter10 & 2, .Range(hcellletter10 & lrow).Address).NumberFormat = "$#,##0.00_);($#,##0.00)"

.Range(hcellletter11 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(numa, 2))
    .Range(hcellletter11 & 2, .Range(hcellletter11 & lrow).Address).NumberFormat = "0.00%"
       
Erase numa()

.Range(hcellletter1 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(rngarray, 1))
    .Range(hcellletter1 & 2, .Range(hcellletter1 & lrow).Address).NumberFormat = "$#,##0.00_);($#,##0.00)"

.Range(hcellletter2 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(rngarray, 3))
     .Range(hcellletter2 & 2, .Range(hcellletter2 & lrow).Address).NumberFormat = "$#,##0.00_);($#,##0.00)"

.Range(hcellletter3 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(rngarray, 4))
     .Range(hcellletter3 & 2, .Range(hcellletter3 & lrow).Address).NumberFormat = "$#,##0.00_);($#,##0.00)"

.Range(hcellletter4 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(rngarray, 5))

.Range(hcellletter5 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(rngarray, 2))

.Range(hcellletter6 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(rngarray, 6))

.Range(hcellletter7 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(rngarray, 8))

.Range(hcellletter8 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(rngarray, 9))
      .Range(hcellletter8 & 2, .Range(hcellletter8 & lrow).Address).NumberFormat = "$#,##0.00_);($#,##0.00)"

.Range(hcellletter9 & 2).Resize(UBound(rngarray, 2)) = Application.Transpose(Application.WorksheetFunction.Index(rngarray, 10))
      .Range(hcellletter9 & 2, .Range(hcellletter9 & lrow).Address).NumberFormat = "$#,##0.00_);($#,##0.00)"
       
  .UsedRange.Value = .UsedRange.Value
    
End With

Erase rngarray()

 Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True


End Sub

[Norie]

Are you sure it's the arrays that are slowing things down?

There is quite a lot of code before the part that handles the arrays is reached.

[Ppessina]

The other parts are just designating columns to be referred to. I just ran that part with the arrays commented out and it came in at .40 seconds. Sometimes the code seems to fall out somewhere and my columns do not get populated. I am getting a run time error 7 out of memory and my array will not get pasted. I dont understand why this is.