VBA - Improve Efficiency

BenGee

Board Regular
Joined
Mar 5, 2016
Messages
178
Hi - I run the below code but it seems very inefficient. Could someone kindly recommend how I could improve speed of execution please?

VBA Code:
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
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
68,159
Office Version
  1. 365
Platform
  1. Windows
Will you only have one file in the folder that is like *Interactions.csv
 

BenGee

Board Regular
Joined
Mar 5, 2016
Messages
178
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
68,159
Office Version
  1. 365
Platform
  1. Windows
Ok, how about
VBA Code:
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
68,159
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,236
Messages
5,768,955
Members
425,506
Latest member
AndreaWorkPlace

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top