For Each loop taking long to run

Hello experts.

I have some code that runs through a few thousand lines of data to look for two conditions and if found copy to a separate spreadsheet to load into a listbox. I'm sure there are many better ways to achieve this which is why I'm reaching out for assistance. I've tried all the usual things to speed it up, but am now at a loss. Currently it takes about 30-40 seconds to complete to even show the userform.

Specifics:
* 2 worksheets (CMR's 2018 and CMR Tracking)
* 26 columns used across
* a few thousand rows (sheet will be used for entire year)

What it's looking for:
If column Y has a date and Z does not (Return the row)
If column W has a name and Y has no date (Return the row)

Here's the code - please suggest away!

Sub OutstandingWOs()

Dim y As Range
Dim i As Long
Dim lastColumn As Integer
Dim lastRowSource As Long
Dim lastRowDestination As Long
Dim wsSource As Worksheet
Dim wsDestination As Worksheet

Set wsSource = Sheets("CMRs " & Year(Now))
Set wsDestination = Sheets("CMR Tracking")

lastColumn = wsSource.Cells(1, Columns.Count).End(xlToLeft).Column
lastRowSource = wsSource.Range("F" & Rows.Count).End(xlUp).Row
lastRowDestination = wsDestination.Range("F" & Rows.Count).End(xlUp).Row + 1

Application.ScreenUpdating = False
EventState = Application.EnableEvents
Application.EnableEvents = False
CalcState = Application.Calculation
Application.Calculation = xlCalculationManual
PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

wsDestination.Range("A2:Z" & lastRowDestination).ClearContents

i = 2

For Each y In wsSource.Range("Y2:Y" & lastRowSource)

If Not IsEmpty(y) And y.Offset(0, 1) = "" Or IsEmpty(y) And y.Offset(0, -2) <> "" Then

y.EntireRow.Copy wsDestination.Cells(i, 1)
    
    i = i + 1
    Else
    End If
Next

Set wsSource = Nothing
Set wsDestination = Nothing

ActiveSheet.DisplayPageBreaks = PageBreakState
Application.Calculation = CalcState
Application.EnableEvents = EventState
Application.ScreenUpdating = True

End Sub

I have not. Great suggestion!

Do you mean to autofilter manually and then copy with VBA, or is there a VBA solution to perform both?

lol...oh ya! Thanks Dave

Can you place an example of the file?
I do not understand the conditions.

If Not IsEmpty(y) And y.Offset(0, 1) = "" Or IsEmpty(y) And y.Offset(0, -2) <> "" Then

What it's looking for:
If column Y has a date and Z does not (Return the row)
If column W has a name and Y has no date (Return the row)

Just a guess without a sample file.

Sub VenA()
  Sheets("CMR Tracking").Cells(1).CurrentRegion.Offset(1).ClearContents
  With Sheets("CMRs " & Year(Now)).Cells(1).CurrentRegion
    .AutoFilter 26, "<>"
    .AutoFilter 23, "<>"
    .Copy Sheets("CMR Tracking").Cells(2, 1)
    .AutoFilter
  End With
End Sub

Sample attached.

AdvancedFilter...

Sub test()
    Dim rng As Range
    With Sheets("CMRs 2018").Cells(1).CurrentRegion
        Set rng = .Offset(, .Columns.Count + 2).Range("a1:a2")
        rng(2).Formula = "=or(and(y2<>"""",z2=""""),and(y2="""",w2<>""""))"
        .AdvancedFilter 2, rng, Sheets("CMR Tracking").Range("a1")
        rng.Clear
    End With
End Sub

Hi ZerOCool,

Thanks for the reply and information. I'm attempting to use jindon's AdvancedFilter above your post, but am only getting the first column of data returned in the CMR Tracking sheet. Rather than ask how to fix it (the easy way), I'm working with the code to try and learn.

I try to do as much as I can without asking for help to try and learn before just getting the answer. I may throw out the "Help" post in a bit but for now, I'll keep at it.

Thank you for your time and suggestions. I've not used "collection" or "dictionary" before - something new to research!

Jay

try this

Sub VenA()
  With Sheets("CMRs " & Year(Now))
    .Range("AD2") = "=OR(AND(Y2>0,Z2=0),AND(W2<>"""",X2=0))"
    .Cells(1).CurrentRegion.AdvancedFilter xlFilterCopy, .Range("AD1:AD2"), Sheets("CMR Tracking").Range("A1:Z1")
    .Range("AD2").Clear
  End With
End Sub

Thanks very much ZerOCool.

I've never heard those two terms (Collection and Dictionary). I appreciate the education and links.

Jay

All,

Here's what I ended up going with:

Sub OutstandingWOs()
Dim lastRowDestination As Long
Dim wsDestination As Worksheet
Dim wsSource As Worksheet

Set wsDestination = Sheets("CMR Tracking")
Set wsSource = Sheets("CMRs " & Year(Now))

lastRowDestination = wsDestination.Range("F" & Rows.Count).End(xlUp).Row

wsDestination.Range("A2:Z" & lastRowDestination).ClearContents

  With wsSource
    .Range("AD2") = "=OR(AND(Y2>0,Z2=0),AND(W2<>"""",X2=0))"
    .Cells(1).CurrentRegion.AdvancedFilter xlFilterCopy, .Range("AD1:AD2"), Sheets("CMR Tracking").Range("A1:Z1")
    .Range("AD2").Clear
  End With

Set wsDestination = Nothing
Set wsSource = Nothing

End Sub

Once I understood how the code works, it made a lot of sense. I appreciate all your suggestion, education and efforts!

Jay

@Norie,
Your code contains a lot of unnecessary declarations and is also extremely slow compared to the advanced fiilter.
I also miss the added value. Well someone who has tested it.

See file for a speedtest.CMR FORM.xlsb