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

 

[Caleeco]

Hello,

WIthout seeing the full code I can only offer guidance.

You will seldom ever need to use the SELECT statement in VBA. This will slow down your code. So instead of this:

[COLOR=#333333]Sheets("Totals").Select[/COLOR]    
Range("A900000").End(xlUp).Select
ActiveCell.Offset(1, 0).Select [COLOR=#333333]    ActiveCell.Value = Num[/COLOR]

use this

Sheets("Totals").Range("A900000").End(xlUp).Offset(1, 0).Value = Num

Also, each time you FINDIVZ you are creating a loop. Instead you should loop once, and search all the entries... rather than searching again and again for all entries individually.

Further code efficiencies can be had by using arrays, vba can loops them far quicker!

Hope that helps
Caleeco

 

[offthelip]

The good news is that your routine can be sped up by a huge amount:
One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.
The way your system is designed you are doing multiple loops (9 loops) where you are searching through the worksheet, you are accessing the worksheet ival times for each loops. This is a lot of worksheet accesses.
The way to improve this is to load the entire sheet into a variant array, and then search using VBA , NOT cells.find. You only need to do one loop and do all 9 checks on each iteration of each loop, I would guess this will get the time down to a couple of seconds.

 

[hitbid]

Thanks Caleeco, these are the types of efficiencies I really need to work on. That change makes a lot of sense.

Offthelip, you are right, but where you say the best way is to load the entire sheet into a variant array, I get it but just not there yet. Any examples or good tutorials for this type of solution? I know know know that you need to search with vba and not cells.find, my skillz just aren't up to par yet.

 

[offthelip]

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

Sub test() 
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
' 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
  If inarr(i, 1) = "Invoice #" Then
  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

 

[Fluff]

Whilst not as fast as using arrays, this should be an improvement on what you have

Sub CountSon()
   Dim Cl As Range
Application.ScreenUpdating = False
    
   For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
      Select Case True
         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

You then just need to add the extra Case Statements.
I've included the Code that @Peter_SSs gave you here https://www.mrexcel.com/forum/excel-questions/1054489-vba-find-text-question.html

 

[hitbid]

Great, thanks to both of you. I am pasting both and trying to understand them and how they work. Thanks for the help, will let you know later how I do. Gotta understand them first!

 

[hitbid]

I experimented with this one a little, noticed I got an error, "TypeMismatch"<type mismatch="">. It ran successfully for about 23 lines then bam, mismatch. I looked at the data and see no reason for it to have stopped.

Case InStr(1, Cl.Value, "Invoice # S", vbTextCompare) > 0

So not sure why that happened.

Whilst not as fast as using arrays, this should be an improvement on what you have

Sub CountSon()
   Dim Cl As Range
Application.ScreenUpdating = False
    
   For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
      Select Case True
         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

You then just need to add the extra Case Statements.
I've included the Code that @Peter_SSs gave you here https://www.mrexcel.com/forum/excel-questions/1054489-vba-find-text-question.html

</type>

 

[Fluff]

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

 

[hitbid]

Thanks for the reply, Fluff. I did not notice any. Will figure out what vbtextcompare errors to and see if i can't figure it out.