Macros kills performance - how to optimize it?

[da1]

Sheet1!A - Date format
Sheet1!B - Time format
Sheet1!F - Number format
Sheet1!K - Number format

Sheet2!D6 - Date format
Sheet2!D7 - Time format
Sheet2!D8 - Number format

Here is algorithm:
1. Find all lines in Sheet1!A that contains Steet2!D6.
If nothing found Then Sheet2!D8="nothing found", exit macros.

2. In lines from step 1, find line in Sheet1!B that contains Sheet2!D7.
If nothing found Then Sheet2!D8="nothing found", exit macros.

3. If(Sheet1!F(#line from step 2) < Sheet!K(#line from step 2), Sheet2!D8=1, Sheet2!D8=0)<sheet!k(#line from="" step="" 2),="" sheet2!d8="1,"><sheet!k(#line from="" step="" 2),="" sheet2!d8="1,">

Sub macro()
Dim l As Integer

Range("d8") = "": l = 0
Do
l = l + 1
If Sheets(1).Cells(l, "a") = Sheets(2).Range("d6") Then
If Sheets(1).Cells(l, "b") = Sheets(2).Range("d7") Then
If Sheets(1).Cells(l, "f") < Sheets(1).Cells(l, "k") Then Range("d8") = 1 Else Range("d8") = 0
End If
End If
Loop Until (l = Sheets(1).Cells.SpecialCells(xlLastCell).Row + 1 Or Range("d8") <> "")
If Range("d8") = "" Then Range("d8") = "nothing found"


End Sub

Any ideas how can I optimize the code?

Thanks,
Dana
</sheet!k(#line></sheet!k(#line>

 

[poolhall]

try Application.Calculation = xlCalculationManual at the beginning and Application.Calculation = xlCalculationAutomatic at the end of your macro.

 

[da1]

try Application.Calculation = xlCalculationManual at the beginning and Application.Calculation = xlCalculationAutomatic at the end of your macro.

I loaded data and run macros, no difference in calculation time at all - 24 seconds without/Application.Calculation VS 24 seconds w/Application.Calculation.

 

[da1]

Any other better ways to write the macros?

 

[poolhall]

how much data do you have?

 

[da1]

how much data do you have?

One sheet have about 40 000 lines by 11 columns (currently it takes ~24 sec for macros).

But I will need to run macros on other 30 similar sheets.

 

[poolhall]

First thing is l type should be declared as Long since you have more than 32767 rows.

Dim l As Long

The main problem, I think is in calculating or calling Sheets(1).Cells.SpecialCells(xlLastCell).Row on each loop. Since you're not deleting rows, try to assign it to variable before you start your loop:

Dim LastRow As Long
...
LastRow = Sheets(1).Cells.SpecialCells(xlLastCell).Row + 1
Do
...
Loop Until (l = LastRow Or Range("d8") <> "")

 

[Jerry Sullivan]

In addition to poolhall's suggestion, another approach would be to eliminate the loop
by using formulas to test your 3 criteria and return the result in D8.

Sub woLoop()
    Dim sFormula As String, sResult As String
    Dim sValD6 As String, sValD7 As String
    Application.ScreenUpdating = False
    With Sheets(2)
        sValD6 = .Range("D6")
        sValD7 = .Range("D7")
    End With
    With Sheets(1).Range("A:A")
        .Parent.Activate
        With .Range(.Cells(1), .Cells(.Rows.Count, 1).End(xlUp))
            sFormula = "SUMPRODUCT(--(" & .Address & "=" & sValD6 & _
                "),--(" & .Offset(0, 1).Address & "=" & sValD7 & "))"
            If Evaluate(sFormula) Then
                sFormula = "SUMPRODUCT(--(" & .Address & "=" & sValD6 & _
                    "),--(" & .Offset(0, 1).Address & "=" & sValD7 & _
                    "),--(" & .Offset(0, 5).Address & "<" & _
                    .Offset(0, 10).Address & "))"
                If Evaluate(sFormula) Then sResult = 1 Else sResult = 0
            Else
                sResult = "nothing found"
            End If
        End With
    End With
    Sheets(2).Range("D8") = sResult
End Sub

 

[poolhall]

First thing is l type should be declared as Long since you have more than 32767 rows.

Dim l As Long

The main problem, I think is in calculating or calling Sheets(1).Cells.SpecialCells(xlLastCell).Row on each loop. Since you're not deleting rows, try to assign it to variable before you start your loop:

Dim LastRow As Long
...
LastRow = Sheets(1).Cells.SpecialCells(xlLastCell).Row + 1
Do
...
Loop Until (l = LastRow Or Range("d8") <> "")

I tried this on a sample file with 40K rows. The introducing the variable alone brought the macro execution time from 11.5 to 1.1 seconds.

Please give your feedback.

 

[da1]

In addition to poolhall's suggestion, another approach would be to eliminate the loop
by using formulas to test your 3 criteria and return the result in D8.

Sub woLoop()
    Dim sFormula As String, sResult As String
    Dim sValD6 As String, sValD7 As String
    Application.ScreenUpdating = False
    With Sheets(2)
        sValD6 = .Range("D6")
        sValD7 = .Range("D7")
    End With
    With Sheets(1).Range("A:A")
        .Parent.Activate
        With .Range(.Cells(1), .Cells(.Rows.Count, 1).End(xlUp))
            sFormula = "SUMPRODUCT(--(" & .Address & "=" & sValD6 & _
                "),--(" & .Offset(0, 1).Address & "=" & sValD7 & "))"
            If Evaluate(sFormula) Then
                sFormula = "SUMPRODUCT(--(" & .Address & "=" & sValD6 & _
                    "),--(" & .Offset(0, 1).Address & "=" & sValD7 & _
                    "),--(" & .Offset(0, 5).Address & "<" & _
                    .Offset(0, 10).Address & "))"
                If Evaluate(sFormula) Then sResult = 1 Else sResult = 0
            Else
                sResult = "nothing found"
            End If
        End With
    End With
    Sheets(2).Range("D8") = sResult
End Sub

I don't understand.. why it doesn't work?

Here is a workbook sample:
https://www.yousendit.com/download/T2dmaXRBUzhsUis5TE5Vag