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]

Couple questions, as I am stepping through this code. I am understanding more as I step through it, I like how it is built to work, makes sense this would be faster.

The line for "lastrow". I thought CELLS needed numbers only, but I see a rows.count, and then an "A". That seems out of order and then wrong with the "A". But it worked fine. Why?

And then the line that says
If inarr(i, 1) = "Invoice #" Then
When this gets to a line that matches, it isn't finding and working. Invoice # is only part of the line
Sample line looks like:
Invoice # S1711111.007 Inside Sales: Joe Smith Outside Sales: Mark Dear Print Status : N
Maybe I need to set it up so the IF has a FIND inside it. That is how I have it setup in my old slow code.
Cells.Find(What:="Invoice # S*",

This some code that should get you started, Note it is untested because I only had 10 minutes to write it.

Sub test() 
lastrow = [U][B]Cells(Rows.Count, "A").End(xlUp).Row[/B][/U]
' load input array column A
inarr = Range(Cells(1, 1), Cells(lastrow, 1))
With Worksheet("Totals")
' clear the output worksheet and load a blnk output array
Range(.Cells(1, 1), .Cells(lastrow, 10)) = ""
outarr = Range(.Cells(1, 1), .Cells(lastrow, 10))
indi = 2
For i = 1 To lastrow
 ' find Invoice
 [U][B] If inarr(i, 1) = "Invoice #" Then[/B][/U]
  num = Left(inarr(i, 1), 22)
   outarr(indi, 1) = num
   indi = indi + 1
  End If
 ' find the thingk you are looking for here and writei nto column B I presume use index 2 i.e outarr(indi,2)
 ' If inarr(i, 1) = "whatever" Then
 ' num = Left(inarr(i, 1), 22)
 '  outarr(indi, 2) = num
 '  indi = indi + 1
 ' End If
 Next i
 
Range(.Cells(1, 1), .Cells(lastrow, 10)) = outarr
 
end with
  
End Sub

 

[hitbid]

Yes. I found a #NAME that came out of nowhere.
It also froze offthelip's macro as well, typemismatch.

I just found them all and removed them. Not a problem.

Do you have any cells that contain something like #N/A, # name?, or the like?

 

[Fluff]

In that case try

Sub CountSon()
   Dim Cl As Range
Application.ScreenUpdating = False
    
   For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
      Select Case True
        [COLOR=#ff0000] Case IsError(Cl.Value)[/COLOR]
         Case InStr(1, Cl.Value, "Invoice #", vbTextCompare) > 0
            Sheets("Totals").Range("A" & Rows.Count).End(xlUp).Value = Left(Cl.Value, 22)
         Case InStr(1, Cl.Value, "Writer", vbTextCompare) > 0
            Sheets("Total").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = trim(Split(Split(Cl.Value, "Writer:")(1), "Tax Jurisdiction:")(0))
      End Select
   Next Cl
End Sub

I've added the line in red, which should deal with the error

 

[hitbid]

Thanks Fluff, that worked.

So in the instance of a CASE needing more options, like the Writer case here. Sometimes there is a "Writer:" in the line, but no name assigned, and the line keeps going as normal.

I accounted for this in my previous writeup, this way:
Writ = InStr(ActiveCell, "Writer:")
Tax = InStr(ActiveCell, "Tax Jur")
Wr = Mid(ActiveCell, Writ + 8, Tax - (Writ + 8))
If Wr = "" Then Wr = "NULL"

I had to have a Null, because if I don't, the writer will get placed where a blank or null should be placed. If that happens it is out of order.

 

[Fluff]

If you always have an invoice number try

         Case InStr(1, Cl.Value, "Writer", vbTextCompare) > 0
            Sheets("Total").Range("A" & Rows.Count).End(xlUp).Offset(, 1).Value = trim(Split(Split(Cl.Value, "Writer:")(1), "Tax Jurisdiction:")(0))

If that doesn't work, can you supply some sample data.

 

[offthelip]

Couple questions, as I am stepping through this code. I am understanding more as I step through it, I like how it is built to work, makes sense this would be faster.

The line for "lastrow". I thought CELLS needed numbers only, but I see a rows.count, and then an "A". That seems out of order and then wrong with the "A". But it worked fine. Why?

And then the line that says
If inarr(i, 1) = "Invoice #" Then
When this gets to a line that matches, it isn't finding and working. Invoice # is only part of the line
Sample line looks like:
Invoice # S1711111.007 Inside Sales: Joe Smith Outside Sales: Mark Dear Print Status : N
Maybe I need to set it up so the IF has a FIND inside it. That is how I have it setup in my old slow code.
Cells.Find(What:="Invoice # S*",

Rows.count does give you a number, also there is the option to use the “A&#8221 ; as an addressing mode for the column.
I use that format for finding the last row all the time.
I never ever use find within VBa because there always faster ways of doing it. Also Find requires a Range as the input, since this code has been written to be as fast as possible, we can’t use find here because we are dealing with variant arrays and not a range.
The way to do the equivalent with this method is to use the instring function INSTR()

If (instr(inarr(i,1),"Invoice #",VBtextcompare) > 0 then

If I had thoguht about it properly I should have realised you needed the instr function, sorry about that

 

[hitbid]

Simple, you just have it run in the next column over with the column offset. Nice, that worked.

If you always have an invoice number try

         Case InStr(1, Cl.Value, "Writer", vbTextCompare) > 0
            Sheets("Total").Range("A" & Rows.Count).End(xlUp).Offset(, 1).Value = trim(Split(Split(Cl.Value, "Writer:")(1), "Tax Jurisdiction:")(0))

If that doesn't work, can you supply some sample data.

 

[hitbid]

No need to say sorry, appreciate the help.
I'll see if I can fit this in to the current code you have. Will take out my cells.find.
Strange though, your code runs through my 90k lines of data, and then only pastes ONE of the invoices, where I was of course expecting it to paste all of them. There are a total of 3,312 "Invoice" lines to return.

The way to do the equivalent with this method is to use the instring function INSTR()

If (instr(inarr(i,1),"Invoice #",VBtextcompare) > 0 then

If I had thoguht about it properly I should have realised you needed the instr function, sorry about that

 

[hitbid]

If (instr(inarr(i,1),"Invoice #",VBtextcompare) > 0 then

This came back with type mismatch after looking at the first line.

First line of data: Detailed Invoice Preview for 03/26/2018 to 04/25/2018 - Batch : - Sortby : Manifest # - Set Print : N Page^####

 

[hitbid]

Fixed it, added a 1 and it worked great:

If (InStr(1, inarr(i, 1), "Invoice # S", vbTextCompare)) > 0 Then

I can't believe how fast this first one was. Wow. Now to apply it to the rest of the options. Challenging, but good to get arrays understood more.

This came back with type mismatch after looking at the first line.

First line of data: Detailed Invoice Preview for 03/26/2018 to 04/25/2018 - Batch : - Sortby : Manifest # - Set Print : N Page^####