VBA Structure Best Practices and Code Review

[Tim_D]

Hi everyone,

I have a functioning Macro and I ventured into unknown VBA code to complete it. After many hours of reading here and other sites, testing, frustration, and finally success, I would like to ask for a review of not only the structure of the code, but also if there are smarter ways to accomplish the end result. The code is meant to do the heavy lifting of pulling data from daily files and updating a master spreadsheet. There is one master workbook for each entity and at least two data files. 2 of the entities have multiple data files (yeah for DoWhile). I was not able to change the naming conventions of the files, the request was denied.
Please feel free to giggle at all the DOEvents in the code.

I also experimented with PowerQuery and got it work and it was faster, however, I haven't researched if PowerQuery can deal with an updated daily file where file name is dynamic with the date added to end of the file name. My contract is over with the company where I created the Macro, so I tabled the PowerQuery approach for later research.

Here is a list of the data files, the templates I created for the Master workbooks, and the final saved Master Workbooks. Please note the file sizes are a concern due to the time it takes to open, format, and copying and pasting huge data sets.

Any tips, tricks, pointers, reference books/websites, and all advice is welcomed. I know I can improve the code, I am just not sure where. Thank you in advance for time.

Option Explicit
     Public StartTime As Double         'Timer
     Public StartTime1 As Double        'Timer
     Public MinutesElapsed As String    'Timer
     Public strFolderName As String     'Varible used to check if network folder exists, and if it doesn't, creates the folder
     Public LastPopulatedRow As Long    'Varible to find first blank cell in a column
     Public dFile As String             'Varible assigned to find partial Data File name string in network folder
     Public fName As String             'Varible for the Data File Name
     Public pFile As String             'Varible assigned to find partial POS Validation File name string in network folder
     Public pName As String             'Varible for the POS Validation File Name
     Public DateVar As Date             'Varible to filter "Timing" Pivot Table to after yesterday's date
     Const fPath = "D:\POS VAL\Data\"   'Network Path for Data files as a constant
     Const pPath = "D:\POS VAL\"        'Network Path for POS Validation Processing files as a constant
Public Sub POS_VALIDATIONS_ALL_FINAL()
'Records Time when Macro Starts
     StartTime = Timer
     StartTime1 = Timer
'All subroutines listed below
     Optimize_Code_On
     TARGET_ALL
          DoEvents
     CAD_CASH_ALL
          DoEvents
     CAD_CC_ALL
          DoEvents
     US_CASH_ALL
          DoEvents
     US_CC_ALL
          DoEvents
     ECOM_ALL
          DoEvents
     TRACKER
          DoEvents
     Optimize_Code_Off
          DoEvents
End Sub
Sub Optimize_Code_On()
'TURN ON - Optimize Code -
     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationManual
     Application.DisplayAlerts = False
     Application.EnableEvents = False
     Application.DisplayStatusBar = False
End Sub
Sub Optimize_Code_Off()
'TURN OFF - Optimize Code -
     Application.ScreenUpdating = True
     Application.Calculation = xlCalculationAutomatic
     Application.DisplayAlerts = True
     Application.EnableEvents = True
     Application.DisplayStatusBar = True
     Application.Visible = True
End Sub
Sub MSGBOX_POSVAL()
     MsgBox "File Not Found" & _
     vbNewLine & "Check source folder to confirm " & (pFile) & "'s exsistence" & _
     vbNewLine & "Click ""OK"" to Exit The Macro!", vbCritical
     Optimize_Code_Off
          DoEvents
     End
End Sub
Sub MSGBOX_DATA()
     MsgBox "File Not Found" & _
     vbNewLine & "Check source folder to confirm " & (dFile) & "'s exsistence" & _
     vbNewLine & "Click ""OK"" to Exit The Macro!", vbCritical
     Workbooks(pName).Activate
     ActiveWorkbook.Close SaveChanges:=False
     Optimize_Code_Off
          DoEvents
     End
End Sub
Sub TARGET_ALL()
     pFile = "POS Val Target.xls*"
     pName = Dir(pPath & pFile)
          If pName <> "" Then
               Workbooks.Open Filename:=pPath & pName, UpdateLinks:=0, ReadOnly:=False
               Application.Visible = False
          Else: MSGBOX_POSVAL
               Exit Sub
          End If
          DoEvents
     Delete_data
          DoEvents
     RNET
          DoEvents
     GL
          DoEvents
     FILESAVE
          DoEvents
End Sub
Sub CAD_CASH_ALL()
     pFile = "POS Val CAD Cash.xls*"
     pName = Dir(pPath & pFile)
          If pName <> "" Then
               Workbooks.Open Filename:=pPath & pName, UpdateLinks:=0, ReadOnly:=False
               Application.Visible = False
          Else: MSGBOX_POSVAL
               Exit Sub
          End If
          DoEvents
     Delete_data
          DoEvents
     RNET
          DoEvents
     GL
          DoEvents
     FILESAVE
          DoEvents
End Sub
Sub CAD_CC_ALL()
     pFile = "POS Val CAD CC.xls*"
     pName = Dir(pPath & pFile)
          If pName <> "" Then
               Workbooks.Open Filename:=pPath & pName, UpdateLinks:=0, ReadOnly:=False
               Application.Visible = False
          Else: MSGBOX_POSVAL
               Exit Sub
          End If
          DoEvents
     Delete_data
          DoEvents
     RNET
          DoEvents
     GL
          DoEvents
     FILESAVE
          DoEvents
End Sub
Sub US_CASH_ALL()
     pFile = "POS Val US Cash.xls*"
     pName = Dir(pPath & pFile)
          If pName <> "" Then
               Workbooks.Open Filename:=pPath & pName, UpdateLinks:=0, ReadOnly:=False
               Application.Visible = False
          Else: MSGBOX_POSVAL
               Exit Sub
          End If
          DoEvents
     Delete_data
          DoEvents
     RNET
          DoEvents
     GL
          DoEvents
     FILESAVE
          DoEvents
End Sub
Sub US_CC_ALL()
     pFile = "POS Val US CC.xls*"
     pName = Dir(pPath & pFile)
          If pName <> "" Then
               Workbooks.Open Filename:=pPath & pName, UpdateLinks:=0, ReadOnly:=False
               Application.Visible = False
          Else: MSGBOX_POSVAL
               Exit Sub
          End If
          DoEvents
     Delete_data
          DoEvents
     RNET
          DoEvents
     GL
          DoEvents
     FILESAVE
          DoEvents
End Sub
Sub ECOM_ALL()
     pFile = "POS Val eCOM.xls*"
     pName = Dir(pPath & pFile)
          If pName <> "" Then
               Workbooks.Open Filename:=pPath & pName, UpdateLinks:=0, ReadOnly:=False
               Application.Visible = False
          Else: MSGBOX_POSVAL
               Exit Sub
          End If
          DoEvents
     Delete_data
          DoEvents
     RNET
          DoEvents
     GL
          DoEvents
     FILESAVE
          DoEvents
End Sub
Sub Delete_data()
'Delete Previous Day's GL & ReconNET Data from POS Val Spreadsheet
     Worksheets("GL").Activate
          If ActiveSheet.AutoFilterMode Then
               ActiveSheet.AutoFilterMode = False
          End If
          DoEvents
          With ActiveSheet
               If .FilterMode Then
                    .AutoFilter
               Else
                    .UsedRange.AutoFilter
               End If
               DoEvents
          End With
          DoEvents
     Rows("2:2").Select
     Range(Selection, Selection.End(xlToRight)).Select
     Range(Selection, Selection.End(xlDown)).Select
     Selection.ClearContents
     Range("A2").Select
     Sheets("Reconnet").Select
          If ActiveSheet.AutoFilterMode Then
               ActiveSheet.AutoFilterMode = False
          End If
          DoEvents
          With ActiveSheet
               If .FilterMode Then
                    .AutoFilter
               Else
                    .UsedRange.AutoFilter
               End If
               DoEvents
          End With
          DoEvents
     Rows("2:2").Select
     Range(Selection, Selection.End(xlToRight)).Select
     Range(Selection, Selection.End(xlDown)).Select
     Selection.ClearContents
     Range("A2").Select
     DoEvents
End Sub
Sub RNET()
     If ActiveWorkbook.Name = "POS Val Target.xlsx" Then
               dFile = "*Target*.csv"
          ElseIf ActiveWorkbook.Name = "POS Val CAD Cash.xlsx" Then
               dFile = "*522 CAD*.csv"
          ElseIf ActiveWorkbook.Name = "POS Val CAD CC.xlsx" Then
               dFile = "*525 CAD*.csv"
          ElseIf ActiveWorkbook.Name = "POS Val US Cash.xlsx" Then
               dFile = "*522 US CASH*.csv"
          ElseIf ActiveWorkbook.Name = "POS Val US CC.xlsx" Then
               dFile = "*52* US CC*.csv"
          ElseIf ActiveWorkbook.Name = "POS Val eCOM.xlsx" Then
               dFile = "*1500*.csv"
     End If
     DoEvents
'File Path and Name for loop
     fName = Dir(fPath & dFile)
          If fName = "" Then
               MSGBOX_DATA
               Exit Sub
          End If
          DoEvents
'Loop through each Excel file in folder
     Do While fName <> ""
          If fName <> "" Then
               Workbooks.Open Filename:=fPath & fName, UpdateLinks:=0, ReadOnly:=False
               Application.Visible = False
          ElseIf fName = "" Then
              Exit Do
          End If
          DoEvents
     RNET_Format
'Get next file name
         fName = Dir
         dFile = ""
         DoEvents
     Loop
     DoEvents
End Sub
Sub RNET_Format()
     If ActiveSheet.Range("AF1") <> "" Then
          RNET_FORMAT1
     ElseIf ActiveSheet.Range("AF1") = "" Then
          RNET_FORMAT2
     End If
     DoEvents
End Sub
Sub RNET_FORMAT1()
'Formats Data for Consistency in structure
     Workbooks(fName).Activate
     Columns("AX:BM").Select
     Selection.Delete Shift:=xlToLeft
     Columns("BJ").Select
     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
      DoEvents
     RNET_FORMAT2
      DoEvents
End Sub
Sub RNET_FORMAT2()
'Text to Columns Format of Store Number
     Workbooks(fName).Activate
     Columns("AX").Select
     Selection.TextToColumns Destination:=Range("AX1"), DataType:=xlDelimited, _
         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
         Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
         :=Array(1, 1), TrailingMinusNumbers:=True
'Copy Reconnet Data Into POS Val Spreadsheet
     Range("AX1:BM1").Select
     Range(Selection, Selection.End(xlDown)).Select
     Selection.Copy
'Find the first blank cell as start of paste range
     Workbooks(pName).Activate
     Worksheets("Reconnet").Activate
     Range("A:A").Activate
     Selection.Find(What:="", After:=Range("A1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
     ActiveCell.PasteSpecial (xlPasteAll)
'Close the Data Workbook
     Workbooks(fName).Close SaveChanges:=False
     DoEvents
'Add formula to subtract Credits from Debits
     Range("Q2").Select
     ActiveCell.FormulaR1C1 = "=ROUND(RC3-RC4,2)"
     Range("Q2").Select
'Find last populated row
     LastPopulatedRow = Range("P" & Rows.Count).End(xlUp).Row
'Select the rows where formula is to be populated
     Range("Q2: " & "Q" & LastPopulatedRow).FillDown
     Application.CutCopyMode = False
     Range("A2").Select
     DoEvents
End Sub
Sub GL()
     If ActiveWorkbook.Name = "POS Val Target.xlsx" Then
          dFile = "*TARGET*.xls*"
     ElseIf ActiveWorkbook.Name = "POS Val CAD Cash.xlsx" Then
          dFile = "*CANADA CASH*.xls*"
     ElseIf ActiveWorkbook.Name = "POS Val CAD CC.xlsx" Then
          dFile = "*CANADA CC*.xls*"
     ElseIf ActiveWorkbook.Name = "POS Val US Cash.xlsx" Then
          dFile = "*US CASH*.xls*"
     ElseIf ActiveWorkbook.Name = "POS Val US CC.xlsx" Then
          dFile = "*US CC*.xls*"
     ElseIf ActiveWorkbook.Name = "POS Val eCOM.xlsx" Then
          dFile = "*ECOM*.xls*"
     End If
     DoEvents
'File Path and Name for loop
     fName = Dir(fPath & dFile)
          If fName = "" Then
               MSGBOX_DATA
               Exit Sub
          End If
          DoEvents
'Loop through each Excel file in folder
     Do While fName <> ""
          If fName <> "" Then
               Workbooks.Open Filename:=fPath & fName, UpdateLinks:=0, ReadOnly:=False
               Application.Visible = False
          ElseIf fName = "" Then
              Exit Do
          End If
          DoEvents
          If ActiveSheet.Range("AM1") = "" Then
               GL_FORMAT1
          ElseIf ActiveSheet.Range("AM1") <> "" Then
               GL_FORMAT2
          End If
          DoEvents
'Get next file name
          fName = Dir
          dFile = ""
          DoEvents
     Loop
     DoEvents
End Sub
Sub GL_FORMAT1()
'Formats Data for Consistency in structure
     Workbooks(fName).Activate
     Columns("Z:Z").Select
     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
     Columns("AG:AI").Select
     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
     Range("Z1").Select
     ActiveCell.FormulaR1C1 = " "
     Range("AG1").Select
     ActiveCell.FormulaR1C1 = " "
     Range("AH1").Select
     ActiveCell.FormulaR1C1 = " "
     Range("AI1").Select
     ActiveCell.FormulaR1C1 = " "
     Range("Z2").Select
     ActiveCell.FormulaR1C1 = " "
     Range("AG2").Select
     ActiveCell.FormulaR1C1 = " "
     Range("AH2").Select
     ActiveCell.FormulaR1C1 = " "
     Range("AI2").Select
     ActiveCell.FormulaR1C1 = " "
     GL_FORMAT2
     DoEvents
End Sub
Sub GL_FORMAT2()
'This deletes rows that contain data in the "Document Header Text"
     Cells.Select
     Selection.AutoFilter
     ActiveSheet.Range("A:AM").AutoFilter Field:=7, Criteria1:="<>"
     Rows("2:2").Select
     Range(Selection, Selection.End(xlDown)).Select
     Range(Selection, Selection.End(xlDown)).Select
     Selection.Delete Shift:=xlUp
     ActiveSheet.Range("A:AM").AutoFilter Field:=7, Criteria1:="="
     Selection.AutoFilter
'This Changes stores numbers to TEXT Format
     Columns("P:P").Select
     Selection.TextToColumns Destination:=Range("P1"), DataType:=xlDelimited, _
         TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
         Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
         :=Array(1, 1), TrailingMinusNumbers:=True
'Copy GL Data file data
     Range("A2").Select
     Range(Selection, Selection.End(xlToRight)).Select
     Range(Selection, Selection.End(xlDown)).Select
     Selection.Copy
'Find the first blank cell as start of paste range
     Workbooks(pName).Activate
     Worksheets("GL").Activate
     Range("A:A").Activate
     Selection.Find(What:="", After:=Range("A1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
     ActiveCell.PasteSpecial (xlPasteAll)
     Range("AM2").Select
'Close the Data file Workbook
     Workbooks(fName).Close SaveChanges:=False
     DoEvents
'Format Sort Date and Time Column for Pivot Tables
     Columns("AK").Select
     Selection.numberformat = "mm/dd/yyyy;@"
     Columns("AL").Select
     Selection.numberformat = "hh:mm:ss;@"
     Range("AM1") = "Sort Time"
     Range("AM2").Select
     Application.CutCopyMode = False
     ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
     Range("AM2").Select
'Find last populated row
     LastPopulatedRow = Range("AL" & Rows.Count).End(xlUp).Row
'Select the rows where formula is to be populated
     Range("AM2: " & "AM" & LastPopulatedRow).FillDown
     Columns("AM").Select
     Selection.numberformat = "mm/dd/yyyy hh:mm:ss"
     Worksheets("GL").Columns("AM").Calculate
'Refresh all Pivot tables with new data
     Workbooks(pName).Activate
'Unfilter Data Sheets
     Sheets("Reconnet").Select
          If ActiveSheet.AutoFilterMode Then
               ActiveSheet.AutoFilterMode = False
          End If
          DoEvents
     DoEvents
     Sheets("GL").Select
          If ActiveSheet.AutoFilterMode Then
               ActiveSheet.AutoFilterMode = False
          End If
          DoEvents
     DoEvents
     Range("A2").Select
'Select GL Pivot Tab and refresh entire workbook
     Worksheets("GL Pivot").Activate
     Application.Calculation = xlCalculationAutomatic
'Sets "Timing" Pivot table "Sort Time" field to filter after yesterday's date.
     DateVar = DateAdd("d", -1, Date)
     Worksheets("GL Pivot").PivotTables("Timing").PivotFields("Sort Time").ClearAllFilters
     Worksheets("GL Pivot").PivotTables("Timing").PivotFields("Sort Time").PivotFilters.Add _
     Type:=xlAfter, Value1:=DateVar
     ActiveWorkbook.RefreshAll
'     Application.Calculation = xlCalculationManual
     Range("D3").Select
     DoEvents
End Sub
Sub FILESAVE()
'Create a new folder with today's date to save an original and unaltered daily file
     strFolderName = (pPath) & Format(Date, "mm.dd.yyyy") & "\"
     If Dir(strFolderName, vbDirectory) <> "" Then
          End If
          DoEvents
     If Dir(strFolderName, vbDirectory) = "" _
          Then MkDir strFolderName
          DoEvents
     Workbooks(pName).Activate
'     ActiveWorkbook.SAVE                         'Not needed now
     If ActiveWorkbook.Name = "POS Val Target.xlsx" Then
               pName = "POS Val Target"
          ElseIf ActiveWorkbook.Name = "POS Val CAD Cash.xlsx" Then
               pName = "POS Val CAD Cash"
          ElseIf ActiveWorkbook.Name = "POS Val CAD CC.xlsx" Then
               pName = "POS Val CAD CC"
          ElseIf ActiveWorkbook.Name = "POS Val US Cash.xlsx" Then
               pName = "POS Val US Cash"
          ElseIf ActiveWorkbook.Name = "POS Val US CC.xlsx" Then
               pName = "POS Val US CC"
          ElseIf ActiveWorkbook.Name = "POS Val eCOM.xlsx" Then
               pName = "POS Val eCOM"
     End If
     DoEvents
     ActiveWorkbook.SaveAs _
     Filename:=(pPath) & Format(Date, "mm.dd.yyyy") & ("\") & (pName) & (" ") _
     & Format(Date, "mm.dd.yyyy") & ".xlsx", _
     FileFormat:=51
     DoEvents
'' Save as for Month End
'     ActiveWorkbook.SaveAs _
'     Filename:=(pPath) & Format(Date, "mm.dd.yyyy") & ("\") & (pName) & (" for ") _
'     & Format(DateAdd("M", -1, Now), "mmmm yyyy") & (" as of ") & Format(Date, "mm.dd.yyyy") & ".xlsx", _
'     FileFormat:=51
'     DoEvents
' Save As for Daily File
     ActiveWorkbook.SaveAs _
     Filename:=(pPath) & Format(Date, "mm.dd.yyyy") & ("\") & (pName) & (" ") _
     & Format(Date, "mmmm yyyy") & ".xlsx", _
     FileFormat:=51
     DoEvents
'Close the POS Val Excel file and reopen to ensure XLSX file is open
     ActiveWorkbook.Close SaveChanges:=False
     DoEvents
'Adds "Macro Timer" times to tracker spreadsheet for Analysis
     Workbooks("Macro Timer Tracker.xlsx").Activate
     Worksheets("Data").Activate
     Columns("A").Find(What:="", After:=Range("A1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
     ActiveCell = Format(Now(), "MM/DD/YYYY hh:mm:ss")
     Columns("B").Find(What:="", After:=Range("B1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
          If pName = "POS Val Target" Then
               ActiveCell.Value = ("Target")
          ElseIf pName = "POS Val CAD Cash" Then
               ActiveCell.Value = ("CAD Cash")
          ElseIf pName = "POS Val CAD CC" Then
               ActiveCell.Value = ("CAD CC")
          ElseIf pName = "POS Val US Cash" Then
               ActiveCell.Value = ("US Cash")
          ElseIf pName = "POS Val US CC" Then
               ActiveCell.Value = ("US CC")
          ElseIf pName = "POS Val eCOM" Then
               ActiveCell.Value = ("eCOM")
          End If
          DoEvents
'Calculates Macro Runtime
     MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
     Columns("C").numberformat = "hh:mm:ss;@"
     Columns("C").Find(What:="", After:=Range("C1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
     ActiveCell = MinutesElapsed
     Columns("D").Find(What:="", After:=Range("D1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
     ActiveCell = Format(Now(), "MMMM")
     ActiveWorkbook.SAVE
     DoEvents
'Reset pName to Null for next POS Val
     pName = ""
     DoEvents
'Reset Timer
     StartTime = 0
     StartTime = Timer
     DoEvents
End Sub
Sub TRACKER()
'Adds "Macro Timer" times to tracker spreadsheet for Analysis
     Workbooks("Macro Timer Tracker.xlsx").Activate
     Columns("A").Find(What:="", After:=Range("A1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
     ActiveCell = Format(Now(), "MM/DD/YYYY hh:mm:ss")
     Columns("B").Find(What:="", After:=Range("B1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
     ActiveCell.Value = ("All Macros")
'Calculates Macro Runtime
     MinutesElapsed = Format((Timer - StartTime1) / 86400, "hh:mm:ss")
     Columns("C").numberformat = "hh:mm:ss;@"
     Columns("C").Find(What:="", After:=Range("C1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
     ActiveCell = MinutesElapsed
     Columns("D").Find(What:="", After:=Range("D1"), _
                 LookIn:=xlValues, LookAt:= _
                 xlWhole, SearchOrder:=xlByRows, _
                 SearchDirection:=xlNext, MatchCase:=True, _
                 SearchFormat:=False).Select
     ActiveCell = Format(Now(), "MMMM")
     ActiveWorkbook.SAVE
     DoEvents
     pName = "POS Val Target"
'Open Daily File
     Workbooks.Open (pPath) & Format(Now(), "MM.DD.YYYY") & "\" & (pName) & " " & _
     Format(Now(), "mmmm yyyy") & ".xlsx"
     DoEvents
''Open Month End
'     Workbooks.Open (pPath) & Format(Now(), "MM.DD.YYYY") & "\" & (pName) & " for " _
'     & Format(DateAdd("M", -1, Now), "mmmm yyyy") & (" as of ") & Format(Date, "mm.dd.yyyy") & ".xlsx"
     Worksheets("GL PIVOT").Select
     Range("D3").Select
'Display Macro Runtime
     MsgBox "Today is " & Format(Date, "DDDD") & Format(Date, " MMMM dd, yyyy ") & _
     vbNewLine & "All Macros Took " & MinutesElapsed & _
     vbNewLine & "to complete!", vbInformation
End Sub

 

[bobsan42]

It's a bit tedious to follow your code on my phone, despite the fact that it's well structured.
So far:
1. Reduce the number of identical procedures by using arguments.
You have several subs that do the same. The only difference in them is the filename - you can replace them by one sub and pass the filename as an argument.
2. Avoid direct "physical" operations to achieve massive performance improvement e.g.
Instead of

range.select
Selection.clearcontents

Use

range.clearcontents

3. You can use

sheet.showalldata

Instead of removing the Filter.

To be continued ... (Possibly, since I'm on a vacation)

 

[Tim_D]

I have watched/read how that using .selection is poor code. However, here comes my VBA newbie, Working with Ranges, i.e. dealing with the minutia of changing the code to stop using recorded macro code that is recycled, this exposes my lack of understanding of the easy stuff, working with ranges. This is one of my code failures, but I have yet to find a resource that explains this simple thing in a way that a guy that has an accounting degree and has taught himself how to use VBA as a measure to deal with slow hardware, lack of IT support, and basically all difficulties that lead someone to explore the world of automation. Or, as I like to say, I am lazy, why should I do it, especially if I can automate it.

 

[Tim_D]

It's a bit tedious to follow your code on my phone, despite the fact that it's well structured.
So far:
1. Reduce the number of identical procedures by using arguments.
You have several subs that do the same. The only difference in them is the filename - you can replace them by one sub and pass the filename as an argument.
2. Avoid direct "physical" operations to achieve massive performance improvement e.g.
Instead of

range.select
Selection.clearcontents

Use

range.clearcontents

3. You can use

sheet.showalldata

Instead of removing the Filter.

To be continued ... (Possibly, since I'm on a vacation)

Thank you, I appreciate your reply. .selection is poor code, and I don't know the best way around it. Weird as it sounds, working with Ranges is my achilles heel, and I need to understand what you mean by argument. My arguments tend to center around our cats and the dog cleaning the litter box, my wife has a different opinion, thus arguments.... VBA Arguments sound so much better... Can you point me to a resource, besides Microsoft, that explains arguments? I find Microsoft's, any VB(et.al.) to be unapproachable as an uneducated VBA Layman. Thank you, I updated my Honey-do list with Argument Resolution, my wife approves but doesn't know why. I will dig deep into your code suggestion and see how I can apply it to my Macro.

Again, I truly appreciate your insight and hope for additional resources.
VB

 

[Tim_D]

It's a bit tedious to follow your code on my phone, despite the fact that it's well structured.
So far:
1. Reduce the number of identical procedures by using arguments.
You have several subs that do the same. The only difference in them is the filename - you can replace them by one sub and pass the filename as an argument.
2. Avoid direct "physical" operations to achieve massive performance improvement e.g.
Instead of

range.select
Selection.clearcontents

Use

range.clearcontents

3. You can use

sheet.showalldata

Instead of removing the Filter.

To be continued ... (Possibly, since I'm on a vacation)

I found one resource to start understanding passing arguments, I will update my code to get rid of all the individual subs for opening each separate entity template file. Could you provide an example?

 

[bobsan42]

Could you provide an example?

For example:

Sub TARGET_ALL (fname as string)
     pName = Dir(pPath & fname)
          If pName <> "" Then
               Workbooks.Open Filename:=pPath & pName, UpdateLinks:=0, ReadOnly:=False
               Application.Visible = False
          Else: MSGBOX_POSVAL
               Exit Sub
          End If
          DoEvents
     Delete_data
          DoEvents
     RNET
          DoEvents
     GL
          DoEvents
     FILESAVE
          DoEvents
End Sub

Then you call it like this:

TARGET_ALL "POS Val Target.xls*"

and you can call it again by just changing the filename ...

 

[bobsan42]

4. This is more of a warning. Using module level variables (esp. when not really necessary) can be tricky - you must be careful not to get a wrong value.

 

[dmt32]

I need to understand what you mean by argument.
VB

• An argument is the value you pass to a Sub or Function that has a parameter.

So for instance, you have two codes

- Optimize_Code_Off
- Optimize_Code_On

You can have just one code to perform both operations by adding a parameter & pass the required argument to it

In this example you just need to pass a Boolean (True / False) value so you add to your sub, a suitable parameter of that data type - in this case I have called it State

Sub Optimize_Code_On(ByVal State As Boolean)
'TURN ON  / OFF- Optimize Code -

     With Application
        .ScreenUpdating = Not State: .DisplayAlerts = Not State
        .EnableEvents = Not State: .DisplayStatusBar = Not State
        .Calculation = IIf(Not State, xlCalculationManual, xlCalculationAutomatic)
    End With
   
End Sub

You then call it as follows

To turn it On

Optimize_Code_On True

and to turn it Off

Optimize_Code_On False

Hope Helpful

Dave

 

[Tim_D]

• An argument is the value you pass to a Sub or Function that has a parameter.

So for instance, you have two codes

- Optimize_Code_Off
- Optimize_Code_On

You can have just one code to perform both operations by adding a parameter & pass the required argument to it

In this example you just need to pass a Boolean (True / False) value so you add to your sub, a suitable parameter of that data type - in this case I have called it State

Sub Optimize_Code_On(ByVal State As Boolean)
'TURN ON  / OFF- Optimize Code -

     With Application
        .ScreenUpdating = Not State: .DisplayAlerts = Not State
        .EnableEvents = Not State: .DisplayStatusBar = Not State
        .Calculation = IIf(Not State, xlCalculationManual, xlCalculationAutomatic)
    End With
  
End Sub

You then call it as follows

To turn it On

Optimize_Code_On True

and to turn it Off

Optimize_Code_On False

Hope Helpful

Dave

Absolutely helpful, that makes perfect sense to me, and I am happily surprised that I was able to "read" and "understand" the VBA syntax without Googling anything... I think a new door has opened to my VBA understanding. Thank you so much for your input.

Any other suggestions?

 

[Tim_D]

4. This is more of a warning. Using module level variables (esp. when not really necessary) can be tricky - you must be careful not to get a wrong value.

I discovered this to be true when my code opened the wrong file or simply didn't find any file. So, with Trial and Error, I got this code to work. Can you expound on the better approach?