Long VBA run time

[hitbid]

I built someone a piece of code that looks through their very old txt files that do not convert to excel very well. I go through the file looking for key words, so in the end they have a nice spreadsheet that has a large table of data, everything aligned and neat.
The code however takes over 5 minutes. I am not sure if it is appropriate to even ask, but if there is anything that sticks out that you think I could improve, I am all ears. I describe the routines here, and I won't post all of the code. My methods are novice and simple and could definitely use some cleaning up I know.

Sub CountSon = this is the main routine that runs and populates the table. In it many other subroutines are called and ran on loops.
For CountSon, I also posted one of the subroutines, for example, NewFindINV. The other routines in CountSon are very similar to NewFindINV.

Sub CountSon()
    Application.ScreenUpdating = False
    
    FindIVZ
    
    Columns("A:A").Select
    Range("A900000").End(xlUp).Select
    LastCell = Selection.Row
    ival = Application.WorksheetFunction.CountIf(Range("A1:A" & LastCell), "*Invoice #*")
    Range("A1").Select


Range("A1").Select
For i = 1 To ival
NewFindINV
Next i


FindIVZ
Range("A1").Select
For i = 1 To ival
Writer
Next i


FindIVZ
Range("A1").Select
For i = 1 To ival
Address
Next i


FindIVZ
Range("A1").Select
For i = 1 To ival
ShipDt
Next i


FindIVZ
Range("A1").Select
For i = 1 To ival
ShipVia
Next i


FindIVZ
Range("A1").Select
For i = 1 To ival
ShipINST
Next i


FindIVZ
Range("A1").Select
For i = 1 To ival
ST
Next i


FindIVZ
Range("A1").Select
For i = 1 To ival
Tax
Next i


FindIVZ
Range("A1").Select
For i = 1 To ival
Freight
Next i


Clean


Application.ScreenUpdating = True
End Sub

NewFindINV

Sub NewFindINV()
Dim Num As String
    FindIVZ


    Cells.Find(What:="Invoice #", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Num = Left(ActiveCell, 22)
    Sheets("Totals").Select
    Range("A900000").End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Num


End Sub

 

[hitbid]

Thanks jdavis, will try that.

Offthelip, I an running through these different IF statements with good results.

This one stalled out for some reason, said it is out of range. I am not seeing the problem. :

    indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Invoice # S", vbTextCompare)) > 0 Then
    Num7 = Trim(Split(inarr(i + 7, 1), "Shipping Instr :")(1))
    outarr(indi, 6) = Num7
    indi = indi + 1
    End If
Next i

Why am I just not looking for Shipping Instructions? Because it is an optional field and may not even be there. But it is always 7 lines down from Invoice #, so this was my idea. Find the Invoice #, then assign Num7 to equal the Trimmed Split value.

 

[hitbid]

Got it.
This array stuff is so fast.

    indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Invoice # S", vbTextCompare)) > 0 Then
        If (InStr(1, inarr(i + 7, 1), "Shipping Instr :", vbTextCompare)) > 0 Then
        Num7 = Trim(Split(inarr(i + 7, 1), "Shipping Instr :")(1))
        Else: Num7 = ""
        End If
    outarr(indi, 6) = Num7
    indi = indi + 1
    End If
Next i

 

[hitbid]

So this macro went from about 5 minutes to less than 5 seconds. Arrays were key. Thanks all to the education.

Sub FinalResultsMacro()
Application.ScreenUpdating = False


'create a new sheet for the totals
NewSheet
'next make sure an invoice sheet is selected
FindIVZ
'next remove the #name  and #num  errors
RemoveErrors


lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 1))
    
With Worksheets("Totals")
    Range(.Cells(2, 1), .Cells(lastrow, 10)) = ""
    outarr = Range(.Cells(2, 1), .Cells(lastrow, 10))


' Begin the Loops here


    indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Invoice # S", vbTextCompare)) > 0 Then
    Num = Left(inarr(i, 1), 22)
    outarr(indi, 1) = Num
    indi = indi + 1
    End If
 Next i
 
    indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Writer:", vbTextCompare)) > 0 Then
    Num = Trim(Split(Split(inarr(i, 1), "Writer:")(1), "Tax Jurisdiction:")(0))
    outarr(indi, 2) = Num
    indi = indi + 1
    End If
Next i
 
    indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Bill to :", vbTextCompare)) > 0 Then
    Num3 = inarr(i + 1, 1)
    Num4 = inarr(i + 2, 1)
    outarr(indi, 3) = Num3 & " " & Num4
    indi = indi + 1
    End If
Next i
 
    indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Shipdate: ", vbTextCompare)) > 0 Then
    Num5 = Mid(inarr(i, 1), 10, 9)
    outarr(indi, 4) = Num5
    indi = indi + 1
    End If
Next i
 
    indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Ship Via:", vbTextCompare)) > 0 Then
    Num6 = Trim(Split(inarr(i, 1), "Ship Via:")(1))
    outarr(indi, 5) = Num6
    indi = indi + 1
    End If
Next i
 
    indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Invoice # S", vbTextCompare)) > 0 Then
        If (InStr(1, inarr(i + 7, 1), "Shipping Instr :", vbTextCompare)) > 0 Then
        Num7 = Trim(Split(inarr(i + 7, 1), "Shipping Instr :")(1))
        Else: Num7 = ""
        End If
    outarr(indi, 6) = Num7
    indi = indi + 1
    End If
Next i


   indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Subtotal :", vbTextCompare)) > 0 Then
    Num8 = Trim(Split(Split(inarr(i, 1), "Subtotal :")(1), "Tax :")(0))
    outarr(indi, 7) = Num8
    indi = indi + 1
    End If
Next i


  indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Tax :", vbTextCompare)) > 0 Then
    Num9 = Trim(Split(Split(inarr(i, 1), "Tax :")(1), "Freight :")(0))
    outarr(indi, 8) = Num9
    indi = indi + 1
    End If
Next i
 
  indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Freight :", vbTextCompare)) > 0 Then
    Num10 = Trim(Split(Split(inarr(i, 1), "Freight :")(1), "Handling :")(0))
    outarr(indi, 9) = Num10
    indi = indi + 1
    End If
Next i


Range(.Cells(2, 1), .Cells(lastrow, 10)).Value = outarr
 
End With
Clean


Application.ScreenUpdating = True


End Sub

 

[offthelip]

Num7 = Trim(Split(inarr(i + 7, 1), "Shipping Instr :")(1))

This line will cause an out of range because you are looping i from 1 to lastrow, the variant array is exasctly the same size, so when i gets to lastrow -6 then index (i+7) is beyond the end of the inarr variant array. I suggest for that loop you index from 1 to lastrow -7 .
I did tell you that arrays will be fast, I estimated a couple of seconds, a bit optimistic but quite close.
I use this all the time:
For fast VBA there is a simple rule : Avoid Accessing the worksheet in a loop.
this is much more important that the things that the spreadsheetguru suggested,