VBA - Improve Efficiency

[BenGee]

Hi - I run the below code but it seems very inefficient. Could someone kindly recommend how I could improve speed of execution please?

Dim MyFolder As String
Dim myfile As String
Dim WB As Workbook
Dim c As Range
Dim Lastrow2 As Long
Dim Lastrow3 As Long
Dim Lastrow4 As Long

Sheets("Answer").Cells.ClearContents
Sheets("Abandon").Cells.ClearContents

Application.ScreenUpdating = False

MyFolder =REDACTED
myfile = Dir(MyFolder & "\*")

Do While myfile <> ""
    Workbooks.Open Filename:=MyFolder & "\" & myfile
    myfile = Dir
Loop

For Each WB In Workbooks
    If WB.Name Like "*Interactions.csv" Then
        With WB.Sheets(1)
            Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A1:X" & Lastrow).Copy
            Workbooks("Spectrum Report.xlsm").Sheets("Answer").Range("A1").PasteSpecial xlPasteValues
            Workbooks("Spectrum Report.xlsm").Sheets("Abandon").Range("A1").PasteSpecial xlPasteValues
        End With
    End If
Next

Application.CutCopyMode = False

For Each WB In Workbooks
    If WB.Name <> "Spectrum Report.xlsm" Then
        WB.Close SaveChanges:=False
    End If
Next

Sheets("Answer").Activate

For Lastrow2 = Sheets("Answer").Range("J" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Left(Range("J" & Lastrow2), 6) <> "JUSTCS" Or Left(Range("J" & Lastrow2), 16) = "JUSTCS_Reception" Then
        Rows(Lastrow2).EntireRow.Delete
    End If
Next

Application.ScreenUpdating = True
Application.ScreenUpdating = False

For Lastrow3 = Sheets("Answer").Range("N" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Range("N" & Lastrow3).Value = "YES" Then
        Rows(Lastrow3).EntireRow.Delete
    End If
Next

Application.ScreenUpdating = True
Application.ScreenUpdating = False

For Lastrow4 = Sheets("Answer").Range("O" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Range("O" & Lastrow4).Value = "customer" Or Range("O" & Lastrow4).Value = "callback" Then
        Rows(Lastrow4).EntireRow.Delete
    End If
Next

Application.ScreenUpdating = True

Thanks in advance

 

[Fluff]

Will you only have one file in the folder that is like *Interactions.csv

 

[BenGee]

Hi Fluff,

Thanks for reaching out and apologies for the delayed reply... Yes, there'll only be one file with that name.

Thanks in advance

 

[Fluff]

Ok, how about

Dim MyFolder As String
Dim myfile As String
Dim WB As Workbook
Dim c As Range
Dim Lastrow2 As Long
Dim Lastrow3 As Long
Dim Lastrow4 As Long

Sheets("Answer").Cells.ClearContents
Sheets("Abandon").Cells.ClearContents

Application.ScreenUpdating = False

MyFolder = REDACTED
myfile = Dir(MyFolder & "\*Interactions.csv")

If myfile <> "" Then
    Set WB = Workbooks.Open(Filename:=MyFolder & "\" & myfile)
Else
   MsgBox "File not found"
   Exit Sub
End If
With WB.Sheets(1)
    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:X" & Lastrow).Copy
    Workbooks("Spectrum Report.xlsm").Sheets("Answer").Range("A1").PasteSpecial xlPasteValues
    Workbooks("Spectrum Report.xlsm").Sheets("Abandon").Range("A1").PasteSpecial xlPasteValues
End With
WB.Close False

Application.CutCopyMode = False


Sheets("Answer").Activate

For Lastrow2 = Sheets("Answer").Range("J" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Left(Range("J" & Lastrow2), 6) <> "JUSTCS" Or Left(Range("J" & Lastrow2), 16) = "JUSTCS_Reception" Then
        Rows(Lastrow2).EntireRow.Delete
    End If
Next

Application.ScreenUpdating = True
Application.ScreenUpdating = False

For Lastrow3 = Sheets("Answer").Range("N" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Range("N" & Lastrow3).Value = "YES" Then
        Rows(Lastrow3).EntireRow.Delete
    End If
Next

Application.ScreenUpdating = True
Application.ScreenUpdating = False

For Lastrow4 = Sheets("Answer").Range("O" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Range("O" & Lastrow4).Value = "customer" Or Range("O" & Lastrow4).Value = "callback" Then
        Rows(Lastrow4).EntireRow.Delete
    End If
Next

Application.ScreenUpdating = True

 

[BenGee]

That's great, thanks very much for your help

 

[Fluff]

You're welcome & thanks for the feedback.