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

 

[offthelip]

I got around to testing my code and made a few modifications , this should work now:

Sub test()

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
' load input array column A
inarr = Range(Cells(1, 1), Cells(lastrow, 1))
With Worksheets("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
 cnt = (InStr(inarr(i, 1), "Invoice #"))
  If (cnt > 0) Then
  num = Mid(inarr(i, 1), cnt, 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]

Thanks a lot. I'll probably ask this and end this thread, probably can create new threads for new types of questions.

Tried to add a second If to the process.

 For i = 1 To lastrow 
 ' find the thingk you are looking for here and writei nto column B I presume use index 2 i.e outarr(indi,2)
    If (InStr(1, inarr(i, 1), "Writer:", vbTextCompare)) > 0 Then
    Num = Trim(Split(Split(inarr, "Writer:")(1), "Tax Juri*")(0))
       ' If Num = "" Then Num = "NULL"
    outarr(indi, 2) = Num
    indi = indi + 1
    End If
 Next i

It keeps failing at the "Num = " area, type mismatch.
I also started to write in a 2nd If, because there may be a writer, but with no name, so it has to put in a null there, but I can't get past the "Num = " part yet.

 

[offthelip]

I think your error is you haven't addressed the variant array correctly, it is a two dimensional array ( just like a worksheet) and so you must give it the two indices

[COLOR=#333333]Num = Trim(Split(Split(inarr, "Writer:")(1), "Tax Juri*")(0))[/COLOR]

shoud be

[COLOR=#333333]Num = Trim(Split(Split(inarr(i,1), "Writer:")(1), "Tax Juri*")(0))[/COLOR]

Having said that i never use split, I always use instr and left, mid and right to do the same thing

 

[hitbid]

Right you are, thanks! Also I don't have to account for the null since Num will equal "" if no writer is found, and your array logic will insert a "" which is perfect.

 

[offthelip]

One thing I have noticed is that you are incrementing the indi index in your second test as well as the first test. This will mean your data will get written in a diagonal line accross the worksheet.
I think what you should do is set a flag (incrementrow) to false at the start of each loop and then set this flag true if any of the tests become valid , then at the end of the loop increment indi if the flag is true. Then you will get a neat layout.

 

[hitbid]

I don't know what that flag is exactly. What i did do instead was start a new indi = 1. I see what you meant though, the 2nd IF statement started a row after where the first IF ended.

Also, why are there periods in this in front of Cells:
Range(.Cells(2, 1), .Cells(lastrow, 10)) = ""
Can't you just type it out the same but w/o the periods?

 

[offthelip]

Can't you just type it out the same but w/o the periods?

definitely not,
just above that line is the line :

With Worksheets("Totals")

the dots signify that the cells are cells on the worksheets ("Totals") worksheet NOT the active worksheet. when you address with just cells it is always on the active sheet.
The with statement and end with allowed me to clear the totals worksheet load the output array with blanks and the output it at the end. note all of those references had dots. I didn't change the activesheet at any time. Which i presumed was the loaded text file

 

[hitbid]

Got it, did not know that, thank you.

Last question for now.
Not used to referencing arrays like this.
When I find "Bill to:", I want to take any and all data from the next two lines below it.
I thought this would be close, but alas i get the "object required".

Thanks for all help with everything. Great message board.

    indi = 1
For i = 1 To lastrow
    If (InStr(1, inarr(i, 1), "Bill to :", vbTextCompare)) > 0 Then
    Num3 = inarr(i, 1).Offset(1, 0).Value
    Num4 = inarr(i, 1).Offset(2, 0).Value
    outarr(indi, 2) = Num3 & " " & Num4
    indi = indi + 1
    End If
Next i

 

[hitbid]

Ha, got it. Love this stuff.

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

 

[jdavis24]

In addition to learning to write more efficient code, this article helped me a lot with improving macro speed:

https://www.thespreadsheetguru.com/...and-prevent-slow-code-execution#disqus_thread

After applying this, a lot of the more complex macros run near-instantly.