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.
Extend down all the formulas in the template file (these formula's are mostly Index+Match formula's)
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
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
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
Related
I am currently making a macro which creates a catalogue and afterwards saves it in different languages as external files. Whenever I save the files with the VBA script below the file is still large (2MB+), but whenever I open the file and delete all references in the Name Manager (these are copied as well it seems), the file is just 30/40 kb.
Is there a VBA formula that automatically deletes the formulas in the Name Manager (only in the external copy, not in the original file!)?
Sub NIP_Version()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("Opbouw catalogus.xlsm").Activate
filenaam = ActiveWorkbook.Path & "\" & "Excel prijslijst" & "\" & Sheets("Catalogus").Range("A1").Text & " " & Sheets("Catalogus").Range("G2").Text
'Quotation blad copy
Sheets("Catalogus").Select
'paste as values
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Dim LastRowNIP As Long
With ActiveSheet
LastRowNIP = .Cells(.Rows.Count, "E").End(xlUp).Row
End With
Set example = Range("A5:G" & LastRowNIP)
example.Value = example.FormulaR1C1
Columns("F").EntireColumn.AutoFit
'Save
Application.ScreenUpdating = True
Sheets("Catalogus").Range("A1").Select
ActiveSheet.Copy
ActiveWorkbook.Sheets("Catalogus").SaveAs Filename:=filenaam, FileFormat:=51
Application.DisplayAlerts = True
ActiveWorkbook.Close SaveChanges:=False
Sub remove_names()
Dim xName As Name
For Each xName In Application.ThisWorkbook.Names
xName.Delete
Next xName
End Sub
Sub NIP_Version()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks("Opbouw catalogus.xlsm").Activate
filenaam = ActiveWorkbook.Path & "\" & "Excel prijslijst" & "\" & Sheets("Catalogus").Range("A1").Text & " " & Sheets("Catalogus").Range("G2").Text
'Quotation blad Copy
Sheets("Catalogus").Select
'Paste as value
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Dim LastRowNIP As Long
With ActiveSheet
LastRowNIP = .Cells(.Rows.Count, "E").End(xlUp).Row
End With
Set example = Range("A5:G" & LastRowNIP)
example.Value = example.FormulaR1C1
Columns("F").EntireColumn.AutoFit
'Save
Application.ScreenUpdating = True
Sheets("Catalogus").Range("A1").Select
ActiveSheet.Copy
ActiveWorkbook.Sheets("Catalogus").SaveAs Filename:=filenaam, FileFormat:=51
Sub remove_names()
Dim xName As Name
For Each xName In Application.ThisWorkbook.Names
xName.Delete
Next xName
End Sub
Application.DisplayAlerts = True
ActiveWorkbook.Close SaveChanges:=False
Workbooks("Prijslijst maken.xlsm").Activate
I keep getting the error "Run-time error '91': "Object Variable or With block variable not set" when my macro gets to the line
matchrange = Workbooks("tracker test").Sheets(start_sheet).Range("F" & h).Value
where I am trying to define the PLnumber that will be compared to the PL_compare_list named range. If I try to not define that variable and instead just put the reference directly into my match function on the line below I instead get the error "Run-time error '1004': Unable to get the Match property of the WorksheetFunction class"
What I am trying to do is have this code look at column H on start_sheet to see if it has data yet. then, if it does not, compare the PL numbers on start_sheet in column F to the PL numbers on "Calculation Sheet" in column B to find a row and then open the corresponding file name that is in column A in that row. Thoughts?
Here is my code in its entirety but I think the most relevant bits will be close to the bottom:
Option Explicit
Sub GetFileNames()
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"=REPLACE(CELL(""filename""),FIND(""["",CELL(""filename"")),LEN(CELL(""filename"")),MID(CELL(""filename""),FIND(""]"",CELL(""filename""),1)+1,255))&""_samples shipment PO_PL_Invoice_ attachment\""&TRIM(MID(CELL(""filename""),FIND(""]"",CELL(""filename""),1)+1,255))&""_PL\"""
Range("B1").Select
ActiveCell.FormulaR1C1 = _
"=left(RC[-1],len(RC[-1])-10)"
Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim directory As String
directory = Range("B1").Value
Dim start_sheet As String
start_sheet = ActiveSheet.Name
Sheets("Calculation Sheet").Activate
Range("D1") = Sheets(start_sheet).Range("A1").Value
Columns("B:B").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Cells(1, 1).Select
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = directory
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
Dim i As Integer
Dim j As Integer
Dim filenumber As Integer
filenumber = Evaluate("CountA(A:A)")
Columns("A:A").Select
Selection.NumberFormat = "#"
j = 1
For i = 1 To filenumber
If InStr(1, Range("A" & i), "xlsx") Then
ActiveSheet.Range("B" & j).Value = ActiveSheet.Range("D1").Value & ActiveSheet.Range("A" & i).Value
j = j + 1
End If
Next i
Columns("B:B").Select
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:E").Select
Application.CutCopyMode = False
Selection.ClearContents
Dim xlfilenumber As Integer
Dim PL_list_length As Integer
xlfilenumber = Evaluate("CountA(A:A)")
ActiveSheet.Range("A1:A" & xlfilenumber).Select
Selection.Name = "list_of_files"
For i = 1 To xlfilenumber
Range("B" & i).Select
ActiveCell.FormulaR1C1 = _
"=MID(RC[-1],FIND(""_PL"",RC[-1],FIND(""_PL\"",RC[-1],1)+4)+1,7)"
Next i
xlfilenumber = Evaluate("CountA(B:B)")
ActiveSheet.Range("A1:A" & xlfilenumber).Select
Selection.Name = "PL_compare_list"
Sheets(start_sheet).Activate
PL_list_length = Evaluate("CountA(F:F)") - 1
Dim h As Integer
Dim g As Integer
Dim filerownum As Integer
Dim matchrange As Range
Dim comparerange As Range
Dim filename As String
For h = 6 To 9
If IsEmpty(Range("J" & h)) Then
matchrange = Workbooks("tracker test").Sheets(start_sheet).Range("F" & h).Value
filerownum = Application.WorksheetFunction.Match(matchrange, Worksheets("Calculation Sheet").Range("PL_compare_list"), 0)
filename = Range("A" & filerownum).Value
Workbooks.Open filename
End If
Next h
Workbooks("tracker test").Sheets(start_sheet).Activate
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
ActiveSheet.Cells(1, 1).Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Cells(1, 2).Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Cells(1, 3).Select
Application.CutCopyMode = False
Selection.ClearContents
End Sub
Ideally there's a bunch of other changes you should consider, but to address the question of how to handle a failed Match:
Dim filerownum As Variant
Dim rngSrch As Range
Set rngSrch = Worksheets("Calculation Sheet").Range("PL_compare_list")
For h = 6 To 9
If IsEmpty(Range("J" & h)) Then
matchrange = Workbooks("tracker test").Sheets(start_sheet).Range("F" & h).Value
'drop the WorksheetFunction
filerownum = Application.Match(matchrange, rngSrch, 0)
'test for error return value
If Not IsError(filerownum) Then
filename = Range("A" & filerownum).Value
Workbooks.Open filename
End If
End If
Next h
I am having trouble pasting.
I have written the code but when it gets to cell and selects it I have tried putting paste in but still does not work.
Code below, the starred bit is the issue
Sheets("Data").Select
If Range("A2") = "" Then
Range("A1").Paste
Else
Selection.End(xlDown).Select
ActiveCell. Offset(0, 1).Select
With Range("A" & Rows.Count).End(xlUp).Offset(1)
End With
ActiveSheet.Range("$D$1:$D$50000").AutoFilter Field:=6, Criteria1:="B"
lastrow = Range("D" & Rows.Count).End(xlUp).Row
Range("D:M").SpecialCells(xlCellTypeVisible).Select
Set Rng = ActiveSheet.AutoFilter.Range
Windows("Pull Back Scans.xlsm").Activate
Sheets("Data").Select
If Range("A2") = "" Then
Range("A1").Paste
Else
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
With Range("A" & Rows.Count).End(xlUp).Offset(1)
End With
**ActiveSheet.PasteSpecial**
Columns("A:J").Select
Columns("A:J").EntireColumn.AutoFit
Windows("Belfast CDC Scans.xlsb").Activate
ActiveWorkbook.Close savechanges:=False
End If
Columns("A:J").Select
Columns("A:J").EntireColumn.AutoFit
Windows("Belfast CDC Scans.xlsb").Activate
ActiveWorkbook.Close savechanges:=False
End If
I am working on automating some reports by pasting data from raw files into my Template called PA Reach. I have named a range "Sumrow" and I need VBA to autosum the numbers above in each of the loops after pasting the data in. Here is what I have and I'm getting errors:
Workbooks.Open datapath & datafile1 & OutputFileExt
Sheets("Rep").Activate
ActiveSheet.UsedRange.AutoFilter
For i = 1 To terrs_to_generate
Workbooks(builder).Sheets("Control").Activate
Range("Reportnum") = i
currfile = Range("CurrFile").Value
currterr = Range("CurrTerr").Value
currRep = Range("currRep").Value
terrname = Range("terrname").Value
DMName = Range("DMName").Value
TMStartDate = Range("TMstartdate").Value
'open template
Workbooks.Open templatepath & templatefile & OutputFileExt
Set currtemplatefile = ActiveWorkbook
Sheets("Control").Select
Sheets("control").Range("terrname") = terrname
Sheets("control").Range("repname") = currRep
Sheets("control").Range("reportdate") = reportdate
Sheets("control").Range("TMstartdate") = TMStartDate
Sheets("control").Range("DMName") = DMName
Sheets("control").Range("Territory") = currterr
Workbooks(datafile1 & OutputFileExt).Activate
Selection.AutoFilter field:=1, Criteria1:=currterr
Range("A1").Select
Range(Selection.Offset(1, 1).End(xlDown), Selection.End(xlToRight)).Copy
currtemplatefile.Activate
Sheets("PA Reach").Select
Range("pasterange").Select
Selection.PasteSpecial Paste:=xlPasteValues
currtemplatefile.Activate
Range("formatrow").Copy
Range("pasterange").Select
Range(Selection.End(xlToRight), Selection.End(xlDown).Offset(0, 0)).Select
Selection.PasteSpecial Paste:=xlPasteFormats
'Delete PasteRange
Range("pasterange").Select
Selection.EntireRow.Delete
'Value Range Sheet so no formulas show
ActiveSheet.UsedRange.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("A1").Select
Sheets("control").Delete
'need to add in sum total
Range("sumrow1").End(xlDown).Offset(1, 0) = "=Sum(" & Range("sumrow1").Address(True, True) & ")"
'save as and close
ActiveWorkbook.SaveAs Filename:=(reportpath & currfile & OutputFileExt) 'not working
There is no need to Select Range("sumrow"), and then use Selection, you can modify the Formula to the Range directly.
Try the code below, it will put the Sum formula at the row below the bottom row of your "sumrow" named range:
Range("sumrow").End(xlDown).Offset(1, 0) = "=Sum(" & Range("sumrow").Address(True, True) & ")"
My program works by calling a number of macros as such:
Sub Start()
Call ClearAll
Call Sales_Download
Call Copy_Sales
Call Receipt_Download
Call Copy_Receipt
Call Copy1
Call Sales_Summary
Call Copy2
Call Receipt_Summary
End Sub
My program breaks at the copy2, which is essentially an exact replica of copy1 wich works fine. When copy2 is ran by itself it works perfectly, but when I attempt to run the entire program it debugs. The bolded line is where the debug happens.
Sub Copy2()
' Copies all data from Receipt Download tab for each location, and saves in a seperate folder
Dim i As Long
Dim lngLastRow As Long, lngPasteRow As Long
'Find the last row to search through
lngLastRow = Sheets("Receipt_Download").Range("J65535").End(xlUp).Row
'Initialize the Paste Row
lngPasteRow = 2
Dim rng As Range
Dim c As Range
Dim endrow
Dim strName As String
Dim ws As Worksheet
Dim j As Long
endrow = Sheets("names").Range("A65000").End(xlUp).Row
Set rng = Sheets("names").Range("A2:A" & endrow)
j = 1
FBO = strName
For Each c In rng
For i = 2 To lngLastRow
strName = c.Value
If Sheets("Receipt_Download").Range("J" & i).Value = strName Then
Sheets("Receipt_Download").Select
Range("A" & i & ":IV" & i).Copy
Sheets("Summary").Select
Range("A" & lngPasteRow & ":IV" & lngPasteRow).Select
ActiveSheet.Paste
lngPasteRow = lngPasteRow + 1
End If
Next i
j = j + 1
Sheets("Receipt_Download").Select
Rows("1:1").Select
Selection.Copy
Sheets("Summary").Select
Rows("1:1").Select
ActiveSheet.Paste
Columns("D:E").Select
Selection.NumberFormat = "m/d/yyyy"
Sheets("Summary").Select
Range("B25000").Select
ActiveCell.FormulaR1C1 = "Grand Total"
Range("B25000").Select
Selection.Font.Bold = True
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])"
Range("G1").Select
Selection.AutoFill Destination:=Range("G1:G24950")
Range("G25000").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)"
Range("G25000").Select
Selection.Copy
Range("F25000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Sheets("Summary").Select
Range("F25000").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Names").Select
With Columns("B")
.Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With
ActiveSheet.Paste
Sheets("Summary").Select
Range("b1:b30000").Select
For Each Cell In Selection
If Cell.Value = "" Then
Cell.ClearContents
End If
Next Cell
Range("b1:b30000").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("Summary").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Names").Select
***With Columns("C")
.Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate***
End With
ActiveSheet.Paste
Sheets("Summary").Select
Range("A1:Z5000").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
File = "C:\Documents and Settings\user\Desktop\New FBO\" & strName & "\" & strName & " Receipts.xls"
ActiveWorkbook.SaveAs Filename:=File, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
IngPasteRow = IngPasteRow + 1
Sheets("Summary").Select
Selection.ClearContents
Next c
End Sub
I would really appreciate any help, I am certainly no VBA master and this has been quite troublesome.
Replace this part of your code
Sheets("Summary").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Names").Select
With Columns("C")
.Find(what:="", after:=.Cells(1, 1), LookIn:=xlValues).Activate
End With
ActiveSheet.Paste
with
Dim lRow As Long
With Sheets("Names")
lRow = .Range("C" & .Rows.Count).End(xlUp).Row + 1
Sheets("Summary").Range("D2").Copy .Range("C" & lRow)
End With
Now try it.
Also few tips
Avoid .Select and .Activate They are a major cause of errors
Indent and appropriately comment your code. Your code is very difficult to read. If you don't indent/comment your code, you will realize that you will not recognize your OWN code if you visit it say after a week :)
In support of Siddharth's answer above, I have take a portion of your code (up to where your break happens) and have indented and avoided the .Select and .Activate that he mentions. Hopefully this gives you a good start on how to make your code more readable for debugging and understanding.
For Each c In rng
For i = 2 To lngLastRow
strName = c.Value
If Sheets("Receipt_Download").Range("J" & i).Value = strName Then
Sheets("Receipt_Download").Range("A" & i & ":IV" & i).Copy _
Destination:=Sheets("Summary").Range("A" & lngPasteRow & ":IV" & lngPasteRow)
lngPasteRow = lngPasteRow + 1
End If
Next i
j = j + 1
Sheets("Receipt_Download").Rows("1:1").Copy Destination:=Sheets("Summary").Rows("1:1")
With Sheets("Summary")
.Columns("D:E").NumberFormat = "m/d/yyyy"
With .Range("B25000")
.Formula = "Grand Total"
.Font.Bold = True
End With
.Columns("G:G").Insert Shift:=xlToRight
With Range("G1")
.FormulaR1C1 = "=IF(RC[-2]=0,""0"",RC[-1])"
.AutoFill Destination:=Range("G1:G24950")
End With
With ("G25000")
.FormulaR1C1 = "=SUM(R[-24950]C:R[-1]C)"
.Copy
End With
.Range("F25000").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Columns("G:G").Delete Shift:=xlToLeft
.Range("F25000").Copy Destination:=Sheets("Names").Columns("B").Find(what:="", after:=Sheets("Names").Cells(1, 1), LookIn:=xlValues)
End With