Reduce Macro Time

Question

I have been worked on a VBA code for past couple of days and everything seems to be working fine till one fine day when I added the below code to it. It marco executed time increased to such an extent that I myself don't when it is going to complete. I have waited for almost 2 hours but it continues to run.

This datasheet that I have is about 15 MB in size and contains around 47,000 rows with 25 columns filled with data. I have running this code to delete rows basis the multiple criteria on Columns "H".

Here is the code. Any help to reduce the runtime is highly appreciated.

Thanks...

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False

Workbooks("Vivar_Template_Blank.xlsx").Sheets("Main & PCO Working").Activate
Dim ws As Worksheet, i&, lastRow&, value$
Set ws = ActiveWorkbook.ActiveSheet
lastRow = ws.Range("H" & ws.Rows.Count).End(xlUp).Row
    For i = lastRow5 To 2 Step -1
    value = ws.Cells(i, 8).value
        If Not (value Like "*Supplier Name*" _
            Or value Like "*[PO]Supplier (Common Supplier)*" _
            Or value Like "*ACCENTURE LLP*" _
            Or value Like "*COGNIZANT TECHNOLOGY SOLUTIONS US CORP*" _
            Or value Like "*INFOSYS LIMITED*" _
            Or value Like "*INFOSYS TECHNOLOGIES LTD*" _
            Or value Like "*INTERNATIONAL BUSINESS MACHINES CORP DBA IBM CORP*" _
            Or value Like "*MINDTREE LIMITED*" _
            Or value Like "*SYNTEL INC*" _
            Or value Like "*TATA AMERICA INTERNATIONAL CORPORATION*") _
            Then
            ws.Rows(i).Delete
        End If
Next

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

Probably it is that it has to evaluate 10 If statements for every row. If you could remove the Like part I guess it would become more efficient, as the possible number of matches becomes smaller then. — Luuklag
– Luuklag, Commented Dec 18, 2015 at 10:47
Thanks for the suggestion. However, what do you suggest to replace Like with... — Mohammad Imran
– Mohammad Imran, Commented Dec 18, 2015 at 10:54
I think you need to sanitize the post removing any names of actual companies or people. — John Alexiou
– John Alexiou, Commented Dec 18, 2015 at 20:58

Alex K. · Accepted Answer · 2015-12-18 11:39:29Z

Or is not short-circuited so each Like expression will be executed, an alternative to halt on the first match (you don't actually need Like in this case, you can use the more efficient InStr):

Dim lookup(9) As String

lookup(0) = "Supplier Name"
lookup(1) = "[PO]Supplier (Common Supplier)"
lookup(2) = "ACCENTURE LLP"
lookup(3) = "COGNIZANT TECHNOLOGY SOLUTIONS US CORP"
lookup(4) = "INFOSYS LIMITED"
lookup(5) = "INFOSYS TECHNOLOGIES LTD"
lookup(6) = "INTERNATIONAL BUSINESS MACHINES CORP DBA IBM CORP"
lookup(7) = "MINDTREE LIMITED"
lookup(8) = "SYNTEL INC"
lookup(9) = "TATA AMERICA INTERNATIONAL CORPORATION"

For i = lastRow5 To 2 Step -1
    value = ws.Cells(i, 8).value

    For j = 0 To UBound(lookup)
        If InStr(Value, lookup(j)) Then
            ws.Rows(i).Delete
            Exit For
        End If
    Next
Next

If any values are empty or there is a large distribution of a constant non-matching value, you should check and exclude them first.

Thanks for the modified code. I executed this and it ran fine but didn't delete any rows. There is no error to debug but no result as well..
In that case you will need to step through it to see whats up.

Fadi · Accepted Answer · 2015-12-18 20:57:54Z

Deleting Rows (Row by Row) is slow , try to use Union and delete all Rows by one time.

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False

Workbooks("Vivar_Template_Blank.xlsx").Sheets("Main & PCO Working").Activate
Dim ws As Worksheet, i&, lastRow&, value$
Dim uRng As Range

Set ws = ActiveWorkbook.ActiveSheet
lastRow = ws.Range("H" & ws.Rows.Count).End(xlUp).Row
    For i = lastRow5 To 2 Step -1 ' !!! maybe lastRow not lastRow5 because there is no value for lastRow5 in your code!!!
    value = ws.Cells(i, 8).value
        If Not (value Like "*Supplier Name*" _
            Or value Like "*[PO]Supplier (Common Supplier)*" _
            Or value Like "*ACCENTURE LLP*" _
            Or value Like "*COGNIZANT TECHNOLOGY SOLUTIONS US CORP*" _
            Or value Like "*INFOSYS LIMITED*" _
            Or value Like "*INFOSYS TECHNOLOGIES LTD*" _
            Or value Like "*INTERNATIONAL BUSINESS MACHINES CORP DBA IBM CORP*" _
            Or value Like "*MINDTREE LIMITED*" _
            Or value Like "*SYNTEL INC*" _
            Or value Like "*TATA AMERICA INTERNATIONAL CORPORATION*") _
        Then
            'ws.Rows(i).Delete
              If uRng Is Nothing Then
                Set uRng = ws.Rows(i)
              Else
                Set uRng = Union(uRng, ws.Rows(i))
              End If

        End If
Next

 If Not uRng Is Nothing Then uRng.Delete

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

nicomp · Accepted Answer · 2015-12-18 11:32:37Z

You could build a set of nested if/else constructs such that your logic terminates when the first true condition is encountered.

    If Not (value Like "*Supplier Name*") then
        ws.Rows(i).Delete
    else if value Like "*[PO]Supplier (Common Supplier)*" then
            ws.Rows(i).Delete
    else if ...


    End If

After you do this, another level of optimization would be to order the 'if' statements from most prevalent to least, thereby reducing the number of expected comparisons.

Collectives™ on Stack Overflow

Reduce Macro Time

3 Answers 3

2 Comments

Comments

Comments

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

2 Comments

Comments

Comments

Related