Could this macro be made more efficient / better

Question

I'm trying to see if the below code could be made in a more efficient / smarter way to allow it to run smoother.

The processes seems to work about 75% of the time. The other 25%, Excel crashes and fails to complete all the steps, prompting me to have to run it again and pray it finishes. This could just be that my laptop lacks the processing power and causes excel to crash (that is what I am hoping to test).

The macro essentially makes a new workbook, names it, then grabs tabs from several other files located on the shared drive, then copy / pastes them into this new workbook. I had to space out the MSG, Style, Title, Response portion as it looks like the body of this message didn't like the code. File names have been removed

Sub Financial_Statements()

    Dim Month As String
    Dim Year As String
    Dim BU As String
    Dim Day As String
    Dim Msg, Style, Title
    BU = InputBox("Please Enter BU", "BU")
    Month = InputBox("Please Enter Month (as MM)", "Month")
    Day = InputBox("Please Enter Last Day of Month (as DD)", "Day")
    Year = InputBox("Please Enter Year (as YY)", "Year")
    BUSite = Application.WorksheetFunction.VLookup(BU, Sheets("Data").Range("A:D"), 3, False)
    Site = Application.WorksheetFunction.VLookup(BU, Sheets("Data").Range("A:D"), 2, False)
    Folder = Application.WorksheetFunction.VLookup(BU, Sheets("Data").Range("A:D"), 4, False)
    MonName = Application.WorksheetFunction.VLookup(Month, Sheets("Data").Range("F:G"), 2, False)
    Thresh = Application.WorksheetFunction.VLookup(BU, Sheets("Thresholds").Range("A:I"), 9, False)

Msg = "Are you sure you want to run for this site?" 'Define Message

Style = vbYesNo 'Message Box Style

Title = "" & BU & " Financial Statements" 'User Defined

Response = MsgBox(Msg, Style, Title)

If Response = vbYes Then

Application.DisplayAlerts = False

    ChDir _
        "\\File
    Workbooks.Open Filename:= _
        "\\File
        , UpdateLinks:=0, ReadOnly:=True
    ChDir _
        "\\File
    ActiveWorkbook.SaveAs Filename:= _
        "\\File
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ChDir _
        "\\File
        "\\File
        ).RunAutoMacros Which:=xlAutoOpen
    Cells.Select
    Range("A2").Activate
    Selection.Copy
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Sheets("P&L").Activate
    Cells.Select
    Range("B2").Activate
    ActiveSheet.Paste
    ActiveWindow.Zoom = 85
    Windows("" & BUSite & "_VOI_20" & Year & "-" & Month & "-" & Day & ".xlsm").Activate
    Range("P60").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Range("P60").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("" & BUSite & "_VOI_20" & Year & "-" & Month & "-" & Day & ".xlsm").Activate
    ActiveWindow.Close
    Sheets("Overhead Analysis").Activate
    ChDir _
        "\\File
    Workbooks.Open Filename:= _
        "\\File
    'Sheets(Array("REPORT")).Select
    'Sheets(Array("REPORT")).Copy After:=Workbooks( _
        "" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Sheets(1)
    'Sheets("REPORT").Name = "Overhead Analysis"
    Cells.Select
    Range("B2").Activate
    Selection.Copy
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Cells.Select
    Range("B2").Activate
    ActiveSheet.Paste
    Windows("" & Site & "_OVERHEAD ANALYSIS.xlsx").Activate
    Range("Y12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Range("Y12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Windows("" & Site & "_OVERHEAD ANALYSIS.xlsx").Activate
    ActiveWindow.Close
    ChDir _
        "\\File
        "\\File
    Sheets(Array("REPORT", "CPT GRAPHS")).Select
    Sheets(Array("REPORT", "CPT GRAPHS")).Copy After:=Workbooks( _
        "" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Sheets(3)
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Sheets("REPORT").Name = "Guest Gen"
    Sheets("CPT GRAPHS").Name = "CPT Graphs"
    Windows("" & Site & "_GUEST_GEN_20" & Year & "-" & Month & "-" & Day & ".xlsm").Activate
    ActiveWindow.Close
    Sheets("Comm Statement").Select
    ChDir _
        "\\File
    Workbooks.Open Filename:= _
        "\\File
    Cells.Select
    Selection.Copy
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Cells.Select
    ActiveSheet.Paste
    Windows("" & Site & "_COMM EXP_20" & Year & "-" & Month & "-" & Day & ".xlsx").Activate
    Range("AR69").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Range("AR69").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("" & Site & "_COMM EXP_20" & Year & "-" & Month & "-" & Day & ".xlsx").Activate
    ActiveWindow.Close
    ActiveWindow.Zoom = 85
    Range("A1").Select
    Sheets("Budget Performance").Select
    ChDir _
        "\\File
    Workbooks.Open Filename:= _
        "\\File& ".xlsx"
    Cells.Select
    Selection.Copy
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Cells.Select
    ActiveSheet.Paste
    Windows("" & BUSite & "_BP_20" & Year & "-" & Month & "-" & Day & ".xlsx").Activate
    Range("AD13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Range("AD13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.Zoom = 85
    Range("A1").Select
    Windows("" & BUSite & "_BP_20" & Year & "-" & Month & "-" & Day & ".xlsx").Activate
    ActiveWindow.Close
    ChDir _
        "\\File
    Workbooks.Open Filename:= _
        "\\File
    'Range("B2").Activate
    'Selection.Copy
    'Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Sheets(Array("MOH", "Charts")).Select
    Sheets(Array("MOH", "Charts")).Copy After:=Workbooks( _
        "" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Sheets(8)
    Sheets("MOH").Name = "Marketing OH Analysis"
    Sheets("Charts").Name = "Mktg OH Analysis Charts"
    'Cells.Select
    'Range("B2").Activate
    'ActiveSheet.Paste
    Windows("" & Site & "_MARKET_OH_20" & Year & "-" & Month & "-" & Day & ".xlsm").Activate
    ActiveWindow.Close
    'DISCOVERY CREDIT TAB - START
    ChDir _
        "\\File
    Workbooks.Open Filename:= _
        "\\File
    Sheets(Array("REPORT")).Select
    Sheets(Array("REPORT")).Copy After:=Workbooks( _
        "" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Sheets(8)
    Sheets("REPORT").Name = "Credit for Discovery"
    Windows("" & Site & "_" & BU & "_DISCOVERY_20" & Year & "-" & Month & "-" & Day & ".xlsm").Activate
    ActiveWindow.Close
    
    ChDir _
        "\\File
    Workbooks.Open Filename:= _
        "\\File
    Cells.Select
    Range("B2").Activate
    Selection.Copy
    Windows("" & BUSite & " Financials " & Month & "-" & Year & ".xlsx").Activate
    Sheets("Flux Report").Select
    Cells.Select
    Range("B2").Activate
    ActiveSheet.Paste
    Windows("" & Site & "_" & BU & "_FLUX_20" & Year & "-" & Month & "-" & Day & ".xlsx").Activate
    ActiveWindow.Close
    ActiveWorkbook.Names.Add _
        Name:="CPT_Owner_Actual", _
        RefersTo:="='Guest Gen'!$AC$41"
    ActiveWorkbook.Names.Add _
    Name:="CPT_New_Owner_Actual", _
    RefersTo:="='Guest Gen'!$AC$40"
    ActiveWorkbook.Names.Add _
    Name:="CPT_Owner_Budget", _
    RefersTo:="='Guest Gen'!$AD$41"
    ActiveWorkbook.Names.Add _
    Name:="CPT_New_Owner_Budget", _
    RefersTo:="='Guest Gen'!$AD$40"
    Sheets("SITE SUMMARY").Select
    Range("D12:E12").Select
    Cells.Replace What:="#REF!", Replacement:="'Guest Gen'!$D$12:$F$53", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveSheet.Visible = xlSheetHidden
    Sheets("P&L").Select
    ActiveWorkbook.Save
    

End If
End Sub

Every code is different, but the way to speed it up it's basically summarized [here](https://stackoverflow.com/a/20754562/3221380) — Sgdva, Apr 07 '22 at 16:56
Could be greatly improved by applying the recommendations from here: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba FYI you do not need to use ChDir before opening/saving a file. — Tim Williams, Apr 07 '22 at 16:56
I would also collect the four (or more) user inputs in a single userform, potentially verifying the correctness of those inputs before moving on to the rest of the logic. Additionally, use many intermediate named variables to [explicitly reference](https://riptutorial.com/excel-vba/example/5110/qualifying-references) your worksheets and ranges. — PeterT, Apr 07 '22 at 18:41
1) Disable screen refresh, 2) don't use select, 3) copy multiple values with one operation. — JAlex, Apr 07 '22 at 19:12
Does this have to be done in an Excel macro? It seems to me, that you just want to create a new workbook, based on the contents of other files. I could achieve this far more efficiently in a small .Net program. — Jonathan Willcock, Apr 07 '22 at 19:32
@JonathanWillcock No not necessarily, that's just above my current knowledge / didn't know that could be something I could do. Thanks for the insight! — Excelhelp998, Apr 08 '22 at 13:38

Could this macro be made more efficient / better

0 Answers0