简体   繁体   中英

VBA Autofill speed issues

I am working on optimising my vba code but until now I haven't succeeded yet. Would there be any possibility that you can look at my code and tell me how I can make it faster?

I have two excel files: 1 of them is the excel template from which the report will be computed and the other 1 is the generator. In the attached code, and I know that it is pretty long, you can find the code that has been written. I am not sure how to optimise this code any further so any help from your side would be helpful.

Thank you,

Jeroen

Sub Prepare_Files()

    Dim TabName As String

    MacroSheet = "Sheet1"
    File_Loc = "File Locations"
    strReportDate = Worksheets(MacroSheet).Range("I23").Value
    strPrevReportDate = Worksheets(MacroSheet).Range("I26").Value
    strInvoiceDate = Worksheets(MacroSheet).Range("I29").Value
    TemplateAUHUHeadyOpen = False

    EEEEEEEEEJJJ = "A. Oipoip Data - YYYYYY"
    EEEEEEEEEUHUH = "B. Oipoip Data - XXXXXXXXXX"
    QQQQQQ_Inv = "C. QQQQQQ Data - Inventory"
    QQQQQQ_Act = "D. QQQQQQ Data - Active"
    Prod_Data = "E. PROD Data"
    Report_Detail = "F. Report Detail"
    Sales_Summary = "G. Sales Summary"
    US_Trial_Plans = "P. US Trial Plans"
    US_Wholesale_Plans = "Q. US Wholesale Plans"
    CAN_Trial_Plans = "R. CAN Trial Plans"
    CAN_Wholesale_Plans = "S. CAN Wholesale Plans"

    JJJ_NA_Data_Locn = Worksheets(File_Loc).Range("B2").Value
    JJJ_UK_Data_Locn = Worksheets(File_Loc).Range("B3").Value
    JJJ_EU_Data_Locn = Worksheets(File_Loc).Range("B4").Value
    UHUH_NA_Data_Locn = Worksheets(File_Loc).Range("B5").Value
    UHUH_UK_Data_Locn = Worksheets(File_Loc).Range("B6").Value
    UHUH_EU_Data_Locn = Worksheets(File_Loc).Range("B7").Value
    QQQQQQ_Act_Data_Locn = Worksheets(File_Loc).Range("B8").Value
    QQQQQQ_Inv_Data_Locn = Worksheets(File_Loc).Range("B9").Value
    Prod_Build_Data_Locn = Worksheets(File_Loc).Range("B10").Value
    TemplateFiles_Locn = Worksheets(File_Loc).Range("B11").Value
    New_Sales_Report_Locn = Worksheets(File_Loc).Range("B12").Value
    ZZZ_Invoice_Data_Locn = Worksheets(File_Loc).Range("B13").Value
    EEEEEEEEEFile_Locn = Worksheets(File_Loc).Range("B14").Value

    ModelYear1 = Worksheets("Settings").Range("B2").Value
    ModelYear2 = Worksheets("Settings").Range("B3").Value
    ModelYear3 = Worksheets("Settings").Range("B4").Value
    ModelYear4 = Worksheets("Settings").Range("B5").Value
    ModelYear5 = Worksheets("Settings").Range("B6").Value

    ReportNum = Worksheets(MacroSheet).Range("I18").Value

    If ReportNum = 1 Then
        All_Reports = False
        All_Reports_1st_No = 1
        All_Reports_last_No = 1
        TabName = EEEEEEEEEJJJ
        JJJ_Data_Locn = JJJ_NA_Data_Locn
    Else
        Exit Sub
    End If

    For All_Reports_No = All_Reports_1st_No To All_Reports_last_No

        If All_Reports_No = 1 Then
            MarketName = "North America"
            OptOuts_ColNo = OptOuts_ColNo1
            VistaCountryname = VistaCountryname1
            SettingsColumnNo = SettingsColumnNo1
            SheetName_Data_In_Daily_Report = SheetName_Data_In_Daily_Report1
            JJJ_Vista_File_Locn = JJJ_NA_Data_Locn
            UHUH_Vista_File_Locn = UHUH_NA_Data_Locn
        End If

    Next All_Reports_No

    JJJ_VistaFile = Dir$(JJJ_Vista_File_Locn & "\YYYYYY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx")
    If Len(JJJ_VistaFile) = 0 Then
        MsgBox ("The Data file 'YYYYYY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx""' is missing")
        Exit Sub
    End If

    UHUH_VistaFile = Dir$(UHUH_Vista_File_Locn & "\YHYHYHYHY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx")
    If Len(UHUH_VistaFile) = 0 Then
        MsgBox ("The Data file 'YHYHYHYHY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx""' is missing")
        Exit Sub
    End If

    OipoipFile = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip")
    If Len(OipoipFile) = 0 Then
        MsgBox ("The Data file 'ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip""' is missing")
        Exit Sub
    End If

    QQQQQQInvFile = Dir$(QQQQQQ_Inv_Data_Locn & "\QQQQQQ Inventory_" & Format(strReportDate, "yyyymmdd") & "*.xls")
    If Len(QQQQQQInvFile) = 0 Then
        MsgBox ("The QQQQQQ Inventory Data file 'QQQQQQ Inventory_" & Format(strReportDate, "yyyymmdd") & "*.xls""' is missing")
        Exit Sub
    End If

    QQQQQQActFile = Dir$(QQQQQQ_Act_Data_Locn & "\QQQQQQ Activated_" & Format(strReportDate, "yyyymmdd") & "*.xls")
    If Len(QQQQQQActFile) = 0 Then
        MsgBox ("The QQQQQQ Activated Data file 'QQQQQQ Activated_" & Format(strReportDate, "yyyymmdd") & "*.xls""' is missing")
        Exit Sub
    End If

    ProdBuildFile = Dir$(Prod_Build_Data_Locn & "\Production Build Data IOIOIOIOIOI_PAPAPAPAPAPAPA.xlsx")
    If Len(ProdBuildFile) = 0 Then
        MsgBox ("The Data file 'Production Build Data IOIOIOIOIOI_PAPAPAPAPAPAPA.xlsx' is missing")
        Exit Sub
    End If

    TemplateFile = Dir$(TemplateFiles_Locn & "\Sales Report V6 Template.xlsx")
    If Len(TemplateFile) = 0 Then
        MsgBox ("The Template file 'Sales Report V6 Template.xlsx' is missing")
        Exit Sub
    End If

    PrevReportFile = Dir$(New_Sales_Report_Locn & "\Sales Report V6 - " & Format(strPrevReportDate, "dd.mm.yyyy") & ".xlsx")
    If Len(PrevReportFile) = 0 Then
        MsgBox ("The Previous Report ( 'Sales Report V6 - " & Format(strPrevReportDate, "dd.mm.yyyy") & ".xlsx' ) is not found.")
        Exit Sub
    End If

    ZZZInvoiceFile = Dir$(ZZZ_Invoice_Data_Locn & "\ZZZ Invoice - " & Format(strInvoiceDate, "mm.yyyy") & ".xlsx")
    If Len(ZZZInvoiceFile) = 0 Then
        MsgBox ("The Previous Report ('ZZZ Invoice - " & Format(strInvoiceDate, "mm.yyyy") & ".xlsx' ) is not found.")
        Exit Sub
    End If

    FolderPath = New_Sales_Report_Locn & "\"

    'Copy the YYYYYY Data from the Vista Data file to the Template's EEEEEEEEEJJJ Sheet

    If ReportNum = 1 Then
        'Now that all the required files are present, Copy the first YYYYYY Vista Data file to the Template
        'But first switch off Auto Caluculate in Excel
        'Application.EnableEvents = False
        Application.Calculation = xlCalculationManual

        If All_Reports_No = 1 Then
            TabName = TabName1
            MarketName = MarketName1
        End If

        'Set the Template to y and clear any exisitng data from the Built Orders tab
        If TemplateAUHUHeadyOpen = False Then
            Set wbTemplate = Workbooks.Open(TemplateFiles_Locn & "\" & TemplateFile)
        ElseIf TemplateAUHUHeadyOpen = True Then
            Workbooks.Item(TemplateFile).Activate
        End If

        'Open the YYYYYY Vista Data File & copy the data
        Set wbJJJVista = Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile)
        Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile).Activate
        Worksheets("All Built Orders").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row

        'Apply Filters
        ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=1, Criteria1:=Array(""), Operator:=xlFilterValues
        ActiveSheet.ShowAllData
        ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=15, Criteria1:=Array( _
        ModelYear1, _
        ModelYear2, _
        ModelYear3, _
        ModelYear4, _
        ModelYear5), Operator:=xlFilterValues
        Filtered_Total = Application.WorksheetFunction.Subtotal(103, [A2:A1040000])

        Range("A2:Y2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the first sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(EEEEEEEEEJJJ).Range("B2").PasteSpecial
        Application.CutCopyMode = False
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        Range("A1").Select

        'Close the Vista Data File, without saIOIOIOIOIOIg
        Workbooks.Item(JJJ_VistaFile).Activate
        ActiveWorkbook.Close SaveChanges:=False


'********
    'Check if the TRTRTRTR Data file exists, in zipped format or the unzipped format
    RTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv")
    If Len(RTRTRT) = 0 Then
        ZippedRTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip")
        If Len(ZippedRTRTRT) = 0 Then
            MsgBox ("The Zipped TRTRTRTR Data File ( 'ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip' ) is not found")
            Exit Sub
        Else
            FolderPath = EEEEEEEEEFile_Locn
            zFile = "ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip"
            UnzipFile FolderPath & "\" & zFile, FolderPath
            RTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv")
            If Len(RTRTRT) = 0 Then
                MsgBox ("The TRTRTRTR Data File ( ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv ) is not found in the zipped file")
                Exit Sub
            Else

                'Copy the WCData from the TRTRTRTR Data file to the Template's WData tab
                'Only need to do this once for all the reports
                Set wbWCData = Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",")
                Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",").Activate
                Range("A2:C2").Select
                Range(Selection, Selection.End(xlDown)).Select

                'Cells.Select
                Selection.Copy
                Range("A1").Select

                With wbTemplate
                    If TemplateAUHUHeadyOpen = True Then
                        wbTemplate.Sheets("T. Oipoip PAPAPAPAPAPAPA").Range("A2").PasteSpecial
                    Else
                        Workbooks.Item(TemplateFile).Activate
                        wbTemplate.Sheets("T. Oipoip PAPAPAPAPAPAPA").Range("A2").PasteSpecial
                        Worksheets("T. Oipoip PAPAPAPAPAPAPA").Select
                        Range("C:C").Select
                        Selection.NumberFormat = "0"
                    End If

                    Range("A1").Select
                    Application.CutCopyMode = False
                    TemplateAUHUHeadyOpen = True
                    RTRTRT_Populated = True

                End With

                With wbWCData
                    Workbooks.Item(RTRTRT).Close
                End With

            End If
        End If
    Else

        RTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv")

        'Copy the WCData from the TRTRTRTR Data file to the Template's WData tab
        'Only need to do this once for all the reports
        'Set wbWCData = Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",")
        'Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",").Activate

        Sheets("T. Oipoip PAPAPAPAPAPAPA").Select
        Range("A1").Select
        ConnectionTxt = "TEXT;" & EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv"
        With ActiveSheet.QueryTables.Add(Connection:=ConnectionTxt, Destination:=Range("$A$1"))
'            .CommandType = 0
            .Name = RTRTRT
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 2
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 2)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

        Range("A1").Select

        Range("A1").Select
        Application.CutCopyMode = False
        TemplateAUHUHeadyOpen = True
        RTRTRT_Populated = True

    End If

'********
        'Open the YHYHYHYHY Vista Data File & copy the data
        Set wbUHUHVista = Workbooks.Open(UHUH_Vista_File_Locn & "\" & UHUH_VistaFile)
        'Workbooks.Open(UHUH_Vista_File_Locn & "\" & UHUH_VistaFile).Activate
        Worksheets("All Built Orders").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row

        'Apply Filters
        ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=1, Criteria1:=Array(""), Operator:=xlFilterValues
        ActiveSheet.ShowAllData
        ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=15, Criteria1:=Array( _
        ModelYear1, _
        ModelYear2, _
        ModelYear3, _
        ModelYear4, _
        ModelYear5), Operator:=xlFilterValues
        Filtered_Total = Application.WorksheetFunction.Subtotal(103, [A2:A1040000])

        'Range("A2:Y2").Select
        Range("A2:Y" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the second sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(EEEEEEEEEUHUH).Range("B2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(EEEEEEEEEUHUH).Select
        Range("A1").Select
        'Selection.End(xlDown).Select
        'NoOfRows_Data = ActiveCell.Row

        'Close the Vista Data File, without saIOIOIOIOIOIg
        'Workbooks.Open(UHUH_Vista_File_Locn & "\" & UHUH_VistaFile).Activate
        Workbooks.Item(UHUH_VistaFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

'********
        'Open the QQQQQQ Inventory Data File & copy the data
        Set wbJasInv = Workbooks.Open(QQQQQQ_Inv_Data_Locn & "\" & QQQQQQInvFile)
        Worksheets("Sheet0").Select
        Range("A2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row

        Range("A2:B2").Select
        Range("A2:B" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("B2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQInvFile).Activate
        Worksheets("Sheet0").Select
        Range("M2:N" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("D2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQInvFile).Activate
        Worksheets("Sheet0").Select
        Range("D2:E" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("F2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQInvFile).Activate
        Worksheets("Sheet0").Select
        Range("H2:H" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("H2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQInvFile).Activate
        Worksheets("Sheet0").Select
        Range("J2:K" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Inv).Range("I2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(QQQQQQ_Inv).Select
        Range("A1").Select

        'Close the Vista Data File, without saIOIOIOIOIOIg
        Workbooks.Open(QQQQQQ_Inv_Data_Locn & "\" & QQQQQQInvFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the QQQQQQ Activated Data File & copy the data
        Set wbJasAct = Workbooks.Open(QQQQQQ_Act_Data_Locn & "\" & QQQQQQActFile)
        Worksheets("Sheet0").Select
        Range("A2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        Range("A2:A" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("B2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("O2:O" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("C2").PasteSpecial
        Application.CutCopyMode = False

        'Set wbJasAct = Workbooks.Open(QQQQQQ_Act_Data_Locn & "\" & QQQQQQActFile)
        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("B2:B" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("D2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("M2:N" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("E2").PasteSpecial
        Application.CutCopyMode = False

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("D2:E" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("G2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(QQQQQQ_Inv).Select

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("H2:H" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("I2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(QQQQQQ_Inv).Select

        Workbooks.Item(QQQQQQActFile).Activate
        Worksheets("Sheet0").Select
        Range("J2:K" & NoOfRows_Data).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(QQQQQQ_Act).Range("J2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(QQQQQQ_Act).Select
        Range("A1").Select

        'Close the Vista Data File, without saIOIOIOIOIOIg
        Workbooks.Item(QQQQQQActFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the Production Build Data File & copy the data
        Set wbJasAct = Workbooks.Open(Prod_Build_Data_Locn & "\" & ProdBuildFile)
        Worksheets("PROD_IOIOIOIOIOI_PAPAPAPAPAPAPA").Select
        Range("A2:D2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the third sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(Prod_Data).Range("C2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(Prod_Data).Select
        Range("A1").Select

        'Close the Production Build Data File, without saIOIOIOIOIOIg
        Workbooks.Open(Prod_Build_Data_Locn & "\" & ProdBuildFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the ZZZ Invoice Data File & copy the data set 1
        Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile)
        'Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        Worksheets("US - Other Charges (Trial Fee)").Select
        Range("A7:I7").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the data trial summary sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(US_Trial_Plans).Range("A2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(US_Trial_Plans).Select
        Range("A1").Select

        'Close the Invoice File, without saIOIOIOIOIOIg
        Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the ZZZ Invoice Data File & copy the data set 2
        Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile)
        'Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        Worksheets("US - January Rate Plan Detail ").Select
        Range("A10:H10").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the data wholesale summary sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(US_Wholesale_Plans).Range("A2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(US_Wholesale_Plans).Select
        Range("A1").Select

        'Close the Invoice File, without saIOIOIOIOIOIg
        Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the ZZZ Invoice Data File & copy the data set 3
        Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile)
        Worksheets("CAN Other Charges (Trial Fee) ").Select
        Range("A7:I7").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

The rest of the code will be in the comment of this query.

This it the rest of the code...

'Go to the Template File & paste the data into the data trial summary sheet
            Workbooks.Item(TemplateFile).Activate
            Sheets(CAN_Trial_Plans).Range("A2").PasteSpecial
            Application.CutCopyMode = False
            Worksheets(CAN_Trial_Plans).Select
            Range("A1").Select

        'Close the Invoice File, without saIOIOIOIOIOIg
        Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Open the ZZZ Invoice Data File & copy the data set 4
        Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile)
        Worksheets("CAN January Rate Plan Detail").Select
        Range("A8:N8").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy

        'Go to the Template File & paste the data into the data wholesale summary sheet
        Workbooks.Item(TemplateFile).Activate
        Sheets(CAN_Wholesale_Plans).Range("A2").PasteSpecial
        Application.CutCopyMode = False
        Worksheets(CAN_Wholesale_Plans).Select
        Range("A1").Select

        'Close the Invoice File, without saIOIOIOIOIOIg
        Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate
        ActiveWorkbook.Close SaveChanges:=False

        'Extend down all the formulae in the Template file
        Workbooks.Item(TemplateFile).Activate
        Worksheets(EEEEEEEEEJJJ).Select
        Range("B2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:A" & NoOfRows_Data
        Range("A2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)

        NoOfRows1 = "AA2:AA" & NoOfRows_Data
        Range("AA2:AA2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        Worksheets(EEEEEEEEEUHUH).Select
        Range("B2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:A" & NoOfRows_Data
        Range("A2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "AA2:AA" & NoOfRows_Data
        Range("AA2:AA2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        Worksheets(QQQQQQ_Inv).Select
        Range("B2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:A" & NoOfRows_Data
        Range("A2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("L2").Value = Format(strReportDate, "dd-mmm-yyyy")
        Range("A1").Select

        Worksheets(QQQQQQ_Act).Select
        Range("B2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:A" & NoOfRows_Data
        Range("A2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("W2").Value = Format(strReportDate, "dd-mmm-yyyy")
        Range("X2").Value = Format(Now(), "dd-mmm-yyyy")
        Range("A1").Select

        NoOfRows1 = "L2:P" & NoOfRows_Data
        Range("L2:P2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "Q2:Q" & NoOfRows_Data
        Range("Q2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "R2:V" & NoOfRows_Data
        Range("R2:V2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        Worksheets(Prod_Data).Select
        Range("C2").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row
        NoOfRows1 = "A2:B" & NoOfRows_Data
        Range("A2:B2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("N2").Value = Format(strReportDate, "dd-mmm-yyyy")
        Range("A1").Select

        NoOfRows1 = "G2:J" & NoOfRows_Data
        Range("G2:J2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "K2:K" & NoOfRows_Data
        Range("K2:K2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "L2:L" & NoOfRows_Data
        Range("L2:L2").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        'Report Detail
        Worksheets(Report_Detail).Select
        Range("A3").Select
        NoOfRows1 = "A3:AB" & NoOfRows_Data
        Range("A3:AB3").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)

        NoOfRows1 = "AC3:AC" & NoOfRows_Data
        Range("AC3").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        NoOfRows1 = "AE3:AL" & NoOfRows_Data
        Range("AE3:AL3").Select
        Selection.AutoFill Destination:=Range(NoOfRows1)
        Range("A1").Select

        'Now switch on the Auto Caluculate in Excel
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    Worksheets(EEEEEEEEEJJJ).Select
    Range("B2").Select

    Sheets(Sales_Summary).Select

    Range("K16").Select
    ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh
    Range("K4").Select
    ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh
    Range("A4").Select
    ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
    Range("A16").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'Replace all the formulae with actual values to speed up opening the report afterwards
    Workbooks.Item(TemplateFile).Activate
    Worksheets(EEEEEEEEEJJJ).Select
    Range("A2").Select
    Selection.End(xlDown).Select
    NoOfRows_Data = ActiveCell.Row
    Range("A2:A" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(EEEEEEEEEUHUH).Select
    Range("A2:A" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(QQQQQQ_Inv).Select
    Range("A2:A" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets(QQQQQQ_Inv).Range("A2").PasteSpecial
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(QQQQQQ_Act).Select
    Range("A2:A" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(QQQQQQ_Act).Select
    Range("L2:V" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(Prod_Data).Select
    Range("A2:B" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(Prod_Data).Select
    Range("G2:L" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    'Workbooks.Item(TemplateFile).Activate
    Worksheets(Report_Detail).Select
    Range("A3:AL" & NoOfRows_Data).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

    'Save the Template As the Activation Report file
    ActiveWorkbook.SaveAs Filename:=(New_Sales_Report_Locn & "\Sales Report V6 - " & Format(strReportDate, "dd.mm.yyyy") & ".xlsx")
    ActiveWorkbook.Close SaveChanges:=True
End If


MsgBox ("The Daily Report(s) generation is now complete.")

End Sub

Sub UnzipFile(ByVal sZipFile As String, ByVal sDestFolder As String)

    Dim objApp As Object
    Dim objArchive As Object
    Dim objDest As Object
    Dim vDestFolder As Variant
    Dim vZipFile As Variant

    Set objApp = CreateObject("Shell.Application")

    vZipFile = sZipFile
    vDestFolder = sDestFolder

    If Dir$(sDestFolder, vbDirectory) = "" Then MkDir sDestFolder

    objApp.Namespace(vDestFolder).CopyHere objApp.Namespace(vZipFile).Items

End Sub
  1. Extend down all the formulas in the template file (these formula's are mostly Index+Match formula's)
  2. Copy the formula's as values to speed up opening the report afterwards

This is a duplication of effort. Depending on how many formulae you have, one thing that could speed this up A LOT would be to use VBA to calculate the values. At the moment, you're using VBA to copy and paste formulae, waiting for the formulae to calculate, copying the formulae, then pasting as values. Just doing the whole calculation in VBA and placing the end result into the spreadsheet should be way quicker. You can use Application.WorksheetFunction to put any function that works in a spreadsheet into your VBA.

I also see you're opening files then closing them without saving changes. Try opening them with ReadOnly:=True . It can make a big speed difference.


Added later:

Depends what you're looking up, but, if you do take my advice and do all the calculation within the VBA, you might well find that Find and Offset are more efficient than MATCH and INDEX . By sheer coincidence, I posted an example of using Find and Offset earlier today: https://stackoverflow.com/a/39410878/2475052

does anyone know how to add this code to make it a readonly spreadsheet open?

'Open the YYYYYY Vista Data File & copy the data
        Set wbJJJVista = Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile)
        Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile).Activate
        Worksheets("All Built Orders").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        NoOfRows_Data = ActiveCell.Row

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM