Improving Macro's efficiency

I have been using a very lengthy macro weekly for the past 3-years. The macro takes about 7 1/2 hours of computer time to run. I am not having success in combining steps within the macro to reduce the time it takes to run this macro. Below is a representative sample of the inefficient and working script in standard font. This is followed by how I thought steps could be combined in bold font. Unfortunately I cannot get the combined step macro to work. Any input on what I am doing wrong would be greatly appreciated. This could be a specific example or generally what I'm doing wrong, or what reference would be the most useful.

    Sheets("Calculations").Select
    Rows("1:9").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("A:O").Select
    Range("O1").Activate
    Selection.ClearContents
  Sheets("Calculations").Columns("A:O").ClearContents
==

    Sheets("Working Data").Select
    Columns("A:O").Select
    Range("O1").Activate
    Selection.ClearContents

    Sheets("Working Data").Columns("A:O").ClearContents
==

    Sheets("Data").Select
    Rows("1:1").Select
    Selection.AutoFilter

    Sheets("Data").Rows("1:1").AutoFilter
==

    Columns("A:O").Select
    Range("O1").Activate
    Selection.Copy

    Columns("A:O").Copy
==

    Sheets("Working Data").Select
    Range("A1").Select
    ActiveSheet.Paste

    Sheets("Working Data").Range("A1").Paste
==
 
    Range("A1:D1").Select
    Application.CutCopyMode = False

    Range("A1:D1").CutCopyMode = False
==

    Sheets("Calculations").Select
    Range("A10").Select
    ActiveSheet.Paste

    Sheets("Calculations").Range("A10").Paste
==

    Sheets("Formulas").Select
    Rows("1:9").Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("Formulas").Rows("1:9").Copy

==

    Sheets("Calculations").Select
    Range("A1").Select
    ActiveSheet.Paste

    Sheets("Calculations").Range("A1").Paste
==

    Sheets("Bay Area").Select
    Range("F572").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

    Sheets("Bay Area").Range("F572").Paste
==

    Sheets("Calculations").Select
    Application.Goto Reference:="R1C15"
    Columns("A:O").Select
    Range("O1").Activate
    Application.CutCopyMode = False
    Selection.ClearContents

   Sheets("Calculations").Range("A1:O1").ClearContents
==

    Sheets("Formulas").Select
    Rows("1:9").Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("Formulas").Range("A1:A9").Copy
==

    Sheets("Calculations").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("F2:BI2").Select
    Application.CutCopyMode = False
    Selection.Copy

    Sheets("Calculations").Range("A1").Paste.Range("F2:BI2").Copy
==
 
    Sheets("Calculations").Select
    Application.Goto Reference:="R1C15"
    Columns("A:O").Select
    Range("O1").Activate
    Application.CutCopyMode = False
    Selection.ClearContents

    Sheets("Calculations").Columns("A:O").Range("O1").ClearContents

Thanks in advance.

Your original code looks like it came from the macro generator, which generates crude but effective code.

I cannot get the combined step macro to work

You would have to be specific about what you want to happen, and what happens instead. Your original code is difficult to reverse engineer, and if your new code doesn't do what you want, it's not helpful.

Also, although the original code is clunky, it does not look like it should take hours to run. How long is the complete code? Can you provide an Excel file so we can run the code, or at least see all of the code? I suspect you have a problem in another part of your code that is not included here.

Yes the original code did come from Excel 2016 macro recorder and then cleaned up some. An interesting twist is despite being written by Excel 2016 I use Excel 365 to run the code because the macro has never worked on Excel 2016 but has work for 3 years using Excel 365. I would think it would work on the version that it was written on before it would work on a different version.

The reason the code takes so long is it is looped with different variables. First it is looped for 39 different geographic areas, then that is looped for 14 weeks and then it is looped for offers versus closings. So the basic script is looped just shy of 1,100 times. Saving 1 second ends up saving nearly 20 minutes off the 7 1/2 current runtime.

I have a sheet "Data" that has about 25,000 records each in row and 15 data point each in a column A-O. I filter this data by closing date, copy and paste into a sheet "Working Data." "Working Data" now contains 1 of 14 weeks worth of data. I filter "Working Data" and select and copy the 1st of 39 geographic areas and copy and paste this into "Calculations" starting in cell A10. I then copy the first 9 rows from "Formulas" and paste starting in cell A1 of "Calculations." I then copy from "Calculations" cells F3 through BI and paste the values into 1 of 39 geographic area sheets starting in column F and the row assigned for this current week is 572. This then loops back and I sort for the 2nd of 39 geographic areas. Then I loop for the remaining 13 weeks. Then I loop back to "Data" and repeat the entire process filtering by offer date.

I am show the steps that I thought could be combined from multiple simple singles line to a more complex single line. Basically I thought I should be able to specify the sheet, the location, and the desired operation all in one line separated by periods.

In addition to improving the efficiency of the macro code, guidance on what would reduce the time of the current clunky macro. Faster CPU, more RAM. I currently use Intel i7-8700 CPU3.20 GHz, 16 GB RAM, Windows 10 Home, 64 bit. The data file is about 65 MB in xlsb and the macro file is 33 MB in xls.

Here is the working code to set up and perform desired operations through the 1st loop of roughly 1,100 loops.

Sub aCLosed572()
    Sheets("Calculations").Select
    Rows("1:9").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("A:O").Select
    Range("O1").Activate
    Selection.ClearContents
    Sheets("Working Data").Select
    Columns("A:O").Select
    Range("O1").Activate
    Selection.ClearContents
    Sheets("Data").Select
    Rows("1:1").Select
    Selection.AutoFilter

' Note the 25,123 is used as I do have up to 25,000 records .

    ActiveSheet.Range("$A$1:$H$25123").AutoFilter Field:=1
    ActiveSheet.Range("$A$1:$H$25123").AutoFilter Field:=2
    ActiveSheet.Range("$A$1:$H$25123").AutoFilter Field:=3
    ActiveSheet.Range("$A$1:$H$25123").AutoFilter Field:=4
    ActiveSheet.Range("$A$1:$H$25123").AutoFilter Field:=5
    ActiveSheet.Range("$A$1:$H$25123").AutoFilter Field:=6
    ActiveSheet.Range("$A$1:$H$25123").AutoFilter Field:=7
    ActiveSheet.Range("$A$1:$H$25123").AutoFilter Field:=6, Operator:=xlFilterValues, Criteria2:=Array(2, _
"11/22/2023", 2, "11/23/2023", 2, "11/24/2023", 2, "11/25/2023", 2, "11/26/2023", 2, "11/27/2023", 2, "11/28/2023", 2, "11/29/2023", 2, "11/30/2023", 2, "12/1/2023", 2, "12/2/2023", 2, "12/3/2023", 2, "12/4/2023", 2, "12/5/2023", 2, "12/6/2023", 2, "12/7/2023", 2, "12/8/2023", 2, "12/9/2023", 2, "12/10/2023", 2, "12/11/2023", 2, "12/12/2023", 2, "12/13/2023", 2, "12/14/2023", 2, "12/15/2023", 2, "12/16/2023", 2, "12/17/2023", 2, "12/18/2023", 2, "12/19/2023", 2, "12/20/2023", 2, "12/21/2023", 2, "12/22/2023", 2, "12/23/2023", 2, "12/24/2023", 2, "12/25/2023", 2, "12/26/2023")
    Columns("A:O").Select
    Range("O1").Activate
    Selection.Copy

' This sets up the first of 14 weeks. There are 35 dates as I use 5 weeks worth of data as a moving "month" for each of the 14 weeks

    Sheets("Working Data").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1:D1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter

' Note the 7,012 is adjusted for the max size of each of the 39 geographic areas.

    ActiveSheet.Range("$A$1:$D$7012").AutoFilter Field:=1, Criteria1:=Array( _
        "Alameda", "Contra Costa", "Marin", "Napa", "San Francisco", "San Mateo", "Santa Clara", "Solano", "Sonoma"), Operator:=xlFilterValues
    Columns("A:O").Select
    Selection.Copy
    Sheets("Calculations").Select
    Range("A10").Select
    ActiveSheet.Paste
    Sheets("Formulas").Select
    Rows("1:9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calculations").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("F2:BI2").Select
    Application.CutCopyMode = False
    Selection.Copy

' Note "Bay Area" is the 1st of 39 output sheets and the 572 is the row assigned this week's data.

    Sheets("Bay Area").Select
    Range("F572").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Calculations").Select
    Application.Goto Reference:="R1C15"
    Columns("A:O").Select
    Range("O1").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Sheets("Working Data").Select

' Note this is where the macro is looped back up to  step just below "Working Data" line below the 35 dates.

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however we recommend that you include code tags around your code.

Please take a moment to add the tags. Posting code between [code] [/code] tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Please see Forum Guideline #2 about code tags and adjust accordingly. Click on Edit to open your post, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here.

I added them but please do this in the future.

But you're not showing us the loops. Please show all the code.

I would start with this:

Option Explicit

Sub SpeedUp_TMS()

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

'run your code
aCLosed572

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

End Sub

Avoid using .Select ... Selection.

This:

    Sheets("Calculations").Select
    Rows("1:9").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("A:O").Select
    Range("O1").Activate
    Selection.ClearContents
    Sheets("Working Data").Select
    Columns("A:O").Select
    Range("O1").Activate
    Selection.ClearContents
    Sheets("Data").Select
    Rows("1:1").Select
    Selection.AutoFilter

Could be this:

    With Sheets("Calculations")
        .Rows("1:9").ClearContents
        .Columns("A:O").ClearContents
    End With
    With Sheets("Working Data")
        .Columns("A:O").ClearContents
    End With
    Sheets("Data").Rows("1:1").AutoFilter

As has been said, it's difficult to know how best to improve the code without knowing the expected outcome.

Fast answers need visual help. Please read the yellow banner at the top of this page on how to attach a file and a mocked up solution.

Is this resolved now? Or do you need more help?


Fast answers need visual help. Please read the yellow banner at the top of this page on how to attach a file and a mocked up solution.

See this for a start: https://techcommunity.microsoft.com/...nce/m-p/173687

And Google: for variations on a theme.