I have created a simple macro that will import 3 xls files into macro and will compare the data and will create a output file with limited fields. But I see my macro file is 33,446 KB even though the macro book sheets are empty.
is there any way to find out which line of code is taking time without doing step by step execution?
Input files & their file sizes
Excel macro file size
Sub Macro_Step_1()
Dim Wkb_1 As Workbook
Dim Autosht As Worksheet, DLDataSht As Worksheet, SAPdataSht As Worksheet, Osht As Worksheet
Set Wkb_1 = ThisWorkbook
Set Autosht = Wkb_1.Sheets("Automation")
Set DLDataSht = Wkb_1.Sheets("GLData")
Set SAPdataSht = Wkb_1.Sheets("YFIINTDSRP")
Set Osht = Wkb_1.Sheets("Output File")
Set Tempsht = Wkb_1.Sheets("Temp")
St = Now()
Call TurnOffStuff
wkbpath = Wkb_1.Path
'***************************************************************************************************************************************
FN = Dir(wkbpath & "\*.*")
Do While FN <> ""
Debug.Print FN
If LCase(FN) Like LCase("*Report*.xls") Then
Compinfo = Compinfo & "|" & FN
Compinfo = IIf(Left(Compinfo, 1) = "|", Mid(Compinfo, 2, Len(Compinfo)), Compinfo)
ElseIf LCase(FN) Like LCase("*Raw*.xlsx") Then
LMPTinfo = FN
End If
FN = Dir()
Loop
'*******************************************Input Files missing alert******************************************************************
If Compinfo = "" Or LMPTinfo = "" Then
ReportName = ""
ReportName = wkbpath & "\" & "Missing Input Files.txt"
Open ReportName For Output As #1
Close #1
Exit Sub
ReportName = ""
End If
'------------------------------------------------------------------------------
'//Clear Contents for Below mentioned Sheets Exluding Header
Wkb_1.Activate
DLDataSht.Rows("2:1000000").EntireRow.Clear
SAPdataSht.Rows("2:1000000").EntireRow.Clear
Tempsht.Rows("2:1000000").EntireRow.Clear
Osht.Rows("1:1000000").EntireRow.Clear
'*****************************Client Data***********************************************************************************************
RptName = Split(Compinfo, "|")
For Each Rsht In RptName
Call Copy_Compinfo_Data("" & Rsht & "", "", "YFIINTDSRP")
Next
Call Copy_LMPTinfo_Data("" & LMPTinfo & "", "", "GLData")
Call OutputMdl
Tempsht.Rows("1:1000000").EntireRow.Clear
'*********************************************************************************************************************************
Call TurnONStuff
'//Automation Run Time & Task Completetion Alert
MsgBox "Process Completed Within " & Format(Now() - St, "HH:MM:SS"), vbInformation
End Sub
Sub Copy_Compinfo_Data(IPWkb As String, IPSheet As String, DestSheetname As String)
Dim Del_1 As Long
Set Wkb_1 = ThisWorkbook
Set Tempsht = Wkb_1.Sheets("Temp")
Tempsht.Rows("1:1000000").EntireRow.Clear
wkbpath = ThisWorkbook.Path
ShtInx = IIf(IPSheet = "", 1, IPSheet)
Set ws_master = Workbooks.Open(wkbpath & "\" & IPWkb)
Shtname = ws_master.Sheets(1).Name
Set ws_Data = ws_master.Sheets(ShtInx)
Wkb_1.Activate
Set OrgFl = Wkb_1.Sheets(DestSheetname)
OrgFl.Select
ws_master.Sheets(1).Activate
Application.CutCopyMode = False
ws_Data.Cells.Copy
Tempsht.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ws_master.Activate
Windows(IPWkb).Close savechanges:=False
Wkb_1.Activate: Tempsht.Select
'HDRrow = 1
Tempsht.Rows("1:7").EntireRow.Delete
Tempsht.Range("A:A").EntireColumn.Delete
Tempsht.Rows("2:2").EntireRow.Delete
Tempsht.Range("C:C").EntireColumn.Delete
Tempsht.Sort.SortFields.Clear
Tempsht.Sort.SortFields.Add2 Key:=Range("A2:A" & LR), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Tempsht.Sort
.SetRange Range("A1:AB" & LR)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Wkb_1.Activate: Tempsht.Select
If Tempsht.AutoFilterMode Then Tempsht.AutoFilterMode = False
Tempsht.Range(Cells(1, 1), Cells(LR, LC)).AutoFilter field:=1, Criteria1:="Company Code"
If LR > 1 Then
Tempsht.Range(Cells(2, 1), Cells(LR, LC)).SpecialCells(xlCellTypeVisible).Delete
End If
Tempsht.ShowAllData
' For Del_1 = LR To 1 Step -1
'Wkb_1.Activate: Tempsht.Select
'Tempsht.Range(Cells(Del_1, 1), Cells(Del_1, LC)).Select
' Coun_ta = Application.WorksheetFunction.CountA(Tempsht.Range(Cells(Del_1, 1), Cells(Del_1, LR)))
' If Tempsht.Range("B" & Del_1) = "" And Coun_ta <= 0 Then
'Tempsht.Rows(Del_1).EntireRow.Select
'Tempsht.Rows(Del_1).EntireRow.Delete
' ElseIf Tempsht.Range("A" & Del_1) = "*" Then
'Tempsht.Rows(Del_1).EntireRow.Select
'Tempsht.Rows(Del_1).EntireRow.Delete
' End If
'Next
Wkb_1.Activate: Tempsht.Select
Tempsht.Cells(1, LC 1) = "Report Name"
'Tempsht.Range(Cells(2, LC), Cells(LR, LC)).Select
Tempsht.Range(Cells(2, LC), Cells(LR, LC)) = IPWkb
Application.CutCopyMode = False
Tempsht.Range(Cells(2, 1), Cells(LR, LC)).Copy
Wkb_1.Activate
OrgFl.Select
OrgFl.Range("A" & LR 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Wkb_1.Activate: OrgFl.Select: OrgFl.Range("A1").Select
Application.CutCopyMode = False
End Sub
Sub Copy_LMPTinfo_Data(IPWkb As String, IPSheet As String, DestSheetname As String)
Set Wkb_1 = ThisWorkbook
Set Tempsht = Wkb_1.Sheets("Temp")
Set Osht = Wkb_1.Sheets("Output File")
Set DLDataSht = Wkb_1.Sheets("GLData")
Tempsht.Rows("1:1000000").EntireRow.Clear
DLDataSht.Rows("2:1000000").EntireRow.Clear
wkbpath = ThisWorkbook.Path
Set ws_master = Workbooks.Open(wkbpath & "\" & IPWkb)
Shtname = ws_master.Sheets(1).Name
Sht_Count = ws_master.Sheets.Count
For ShtInx = 1 To Sht_Count
Shtname = ws_master.Sheets(ShtInx).Name
Set ws_Data = ws_master.Sheets(ShtInx)
Wkb_1.Activate
Set OrgFl = Wkb_1.Sheets(DestSheetname)
OrgFl.Select
'OrgFl.Cells.Clear
ws_master.Sheets(Shtname).Activate
Application.CutCopyMode = False
ws_Data.Cells.Copy
Tempsht.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Tempsht.Rows("1:1").EntireRow.Delete
Tempsht.Columns("D:D").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Tempsht.Columns("F:F").TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Tempsht.Columns("J:J").TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Tempsht.Columns("M:M").TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Tempsht.Columns("Q:Q").TextToColumns Destination:=Range("Q1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Tempsht.Columns("U:U").TextToColumns Destination:=Range("U1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Tempsht.Columns("G:H").NumberFormat = "MM/DD/YYYY"
TEmpLastRow = Tempsht.Cells(Rows.Count, 3).End(xlUp).Row
Tempsht.Columns("A").Insert: Tempsht.Range("A1") = "Month"
Wkb_1.Activate: Tempsht.Select
Tempsht.Range(Cells(2, "A"), Cells(TEmpLastRow, "A")) = Shtname & "'" & Format(Now(), "YY")
Wkb_1.Activate: Tempsht.Select
Application.CutCopyMode = False
Tempsht.Range(Cells(2, 1), Cells(LR, LC)).Copy
Wkb_1.Activate
DLDataSht.Select
LastRow = DLDataSht.Cells(Rows.Count, 3).End(xlUp).Row
DLDataSht.Range("A" & LastRow 1).PasteSpecial
Application.CutCopyMode = False
ws_master.Activate
Next
Windows(IPWkb).Close savechanges:=False
End Sub
Sub OutputMdl()
Set Wkb_1 = ThisWorkbook
Set Autosht = Wkb_1.Sheets("Automation")
Set DLDataSht = Wkb_1.Sheets("GLData")
Set SAPdataSht = Wkb_1.Sheets("YFIINTDSRP")
Set Osht = Wkb_1.Sheets("Output File")
Set Tempsht = Wkb_1.Sheets("Temp")
Osht.Rows("1:1000000").EntireRow.Clear
Wkb_1.Activate: Osht.Select
Wkb_1.Activate: DLDataSht.Select
Application.CutCopyMode = False
DLDataSht.Range(Cells(1, 1), Cells(LR, LC)).Copy
Wkb_1.Activate
Osht.Select
Osht.Range("A1").PasteSpecial
Application.CutCopyMode = False
' Osht.Range("O:O").EntireColumn.Delete
Osht.Range("R:V").EntireColumn.Delete
Osht.Range("C:C").EntireColumn.Delete
Osht.Columns("F:F").Insert Shift:=xlToRight
Osht.Range("F1") = "Section"
Osht.Range("F2:F" & LR).Formula = "=VLOOKUP(G2,Mapping!A:B,2,0)"
Osht.Columns("J:J").Insert Shift:=xlToRight
Osht.Range("J1") = "Expense G/L"
Osht.Range("J2:J" & LR).Formula = "=VLOOKUP(G2,Mapping!A:B,2,0)"
Osht.Columns("P:V").Insert Shift:=xlToRight
Osht.Range("P1") = "Vendor Code"
Osht.Range("P2:P" & LR).Formula = "=VLOOKUP(G2,YFIINTDSRP!H:J,3,0)"
Osht.Range("Q1") = "Vendor Name"
Osht.Range("Q2:Q" & LR).Formula = "=VLOOKUP(G2,YFIINTDSRP!H:K,4,0)"
Osht.Range("R1") = "Vendor PAN"
Osht.Range("R2:R" & LR).Formula = "=VLOOKUP(G2,YFIINTDSRP!H:L,5,0)"
Osht.Range("T2:T" & LR).Formula = "=LEFT(S2,4)"
Osht.Range("U2:U" & LR).Formula = "=RIGHT(U2,1)"
Osht.Range("V1") = "WHT Base Amount"
Osht.Range("W1") = "Amount in local curre ncy As per GL"
Osht.Range("Y1") = "Return TDS"
Osht.Range("Z1") = "Return rateS"
Osht.Range("Z2:Z" & LR).Formula = "=Y2/W2*100"
Osht.Range("AA1") = "RPU Base"
Osht.Range("AA2:AA" & LR).Formula = "=-W2"
Osht.Range("AB1") = "RPU TDS"
Osht.Range("AB2:AB" & LR).Formula = "=-Y2"
'Osht.Range("R1") = "Vendor PAN"
'Osht.Range("R2:R" & LR).Formula = "=VLOOKUP(H2,YFIINTDSRP!H:L,5,0)"
Osht.Columns("A:A").Insert Shift:=xlToRight
Osht.Range("A1") = "Working Remark"
Osht.Range("AE1") = "Certifiacte"
Osht.Range("AF1") = "Reason"
Osht.Range("AG1") = "BSRCode"
Osht.Range("AH1") = "Tender Date"
Osht.Range("AI1") = "Challan Sn"
Osht.Range("AJ1") = "SN"
'-----------------------------------------------------------------
'//Creating Output file
Path = ThisWorkbook.Path
Dim OWkb As Workbook
Set OWkb = Workbooks.Add
File_Name = Autosht.Range("D8")
Wkb_1.Sheets("Output File").Copy OWkb.Sheets(OWkb.Sheets.Count)
OWkb.SaveAs Filename:=Path & "\" & File_Name, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
OWkb.Activate: OWkb.Sheets("Output File").Range("A1").Select: OWkb.Save: Windows(File_Name).Close
End Sub
CodePudding user response：
Try the Cleaning process for each sheet.
From the Last Edited Column till the End column (Towards Right).Select and Delete all columns (Ctrl '-') From the Last Edited Row till the End Row (Towards Bottom).Select and Delete all rows (Ctrl '-')
CodePudding user response：
Regarding 'Macro file size': No answer for this other than to suggest:
- Export the modules from the 'big' macro workbook
- Create a brand new workbook
- Import the files from step 1 into the new workbook.
The new workbook will be smaller. If it grows every time you run your code - then that's where you can start to figure out the problem. Run just parts of the code until you can detect what code is changing the file size.
Your next question is how to find slow or lengthy operations. This can be done with code like:
Dim timeDuration As Variant
Dim timeStart As Variant
Dim timeEnd As Varient
timeStart = Timer
'Call a function or subroutine
timeEnd = Timer
Debug.Print "<Method Name> duration: " & CStr(timeEnd - timeStart)
Evaluate the results in the Immediate window
Or, you can put the code within each method and grab timeStart at the top of the method and timeEnd at the bottom.
It is helpful here is to have code that is grouped into focused methods that the above code can surround. The provided code has 4 methods...so that would be the first set of results to look at - and then proceed from there.
Evaluating the code was harder than it needed to be due to coding style. Some suggestions for you to consider:
Option Explicit
There are few VBA guidelines that fall under the category of always, but this is one of them:
Always declare Option Explicit at the top of any module you create in VBA. Option Explicit forces the developer to explicitly declare all variables, constants, and fields before using them within a module.
Declaring Option Explicit at the top of the provided code and invoking 'Debug -> Compile VBA Project' will identify 44 local variables that are used, but never declared and two subroutines that prevent the posted code from compiling (I assume the subroutines exist in another module...just not the one posted).
(Suggestion) The Visual Basice Editor (VBE) will automatically place Option Explicit at the top of new modules by checking 'Tools -> Options... -> Require Variable Declaration'.
Use Meaningful Names
All developers spend far more time reading code that writing it. Consequently, it is exceedingly important that code has variable names that are easily interpreted as to content and functionality. While actively writing code, it is easy to know/remember what variables like LR and/or LC mean. Step away from the code for 24 hours (or read it for the first time on an SO question)...and it's not.
The standard joke is: There are 2 hard problems in computer science: cache invalidation, naming things, and off-by-1 errors. That 'naming things' makes the list underscores both its importance (and difficulty). Long names will not slow down your code...use longer/descriptive names to make your life easier.
(Suggestion)Use names that are at least three characters but preferably full words that convey some meaning. Consider the name from the perspective of a first-time reviewer.
Manage variable Scope
This is related to using Option Explicit. There are 3 variable scopes in VBA: Global, Module, and Local. Some variables names in this code are repeated/used in several subroutines. These variables should be declared explicitly at the top of the module (Module Scope).
Look at how variable Wkb_1 is used. It is declared in Macro_Step_1 but used (without a declaration) in the next 3 subroutines. It is a Workbook object in the Macro_Step_1 (by declaration), but is a Variant in all subsequent uses because it is not explicitly declared. Further, it is assigned the Global ThisWorkbook object. ThisWorkbook should be used directly and Wkb_1 can be deleted. And, relating back to 'Use Meaningful Names', using Wkb_1 obscures the fact (further down the procedure) that it represents the ThisWorkbook object. wkbpath = ThisWorkbook.Path is much more clear than wkbpath = Wkb_1.Path.
(Suggestion) Review all your variables' scope and declare them in the appropriate locations.
Don't Repeat Yourself (DRY)
If you find yourself with a workflow of 'Copy - Paste - change a string', it is time to consider how to capture the code in a procedure. This will make your code easier to read, understand, and sometimes...faster depending on the operations involved.
The code
Tempsht.Columns("D:D").TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Was created using the above workflow 6 times. The entire wall of copied code can be replaced with:
GiveThisOperationAName "D", "F", "J", "M", "Q", "U"
Where GiveThisOperationAName is:
Private Sub GiveThisOperationAName(ParamArray columnLetters() As Variant)
Dim tempWorksheet As Worksheet
Set tempWorksheet = ThisWorkbook.Sheets("Temp")
Dim columnLetter As Variant
For Each columnLetter In columnLetters
tempWorksheet.Columns(columnLetter & ":" & columnLetter).TextToColumns _
Destination:=Range(columnLetter & "1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Next
End Sub
(Suggestion) There are other areas of opportunity like this. Removing duplication will make your code easier to read/understand, easier to maintain/modify, and easier to instrument for performance testing.