Tim_D

New Member
Joined
Apr 23, 2020
Messages
10
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.

Screenshot 2021-08-31 134340.png
1630431924065.png
1630432730642.png


VBA Code:
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
 

Attachments

  • 1630432624626.png
    1630432624626.png
    172.9 KB · Views: 7

Tim_D

New Member
Joined
Apr 23, 2020
Messages
10
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
For example:
VBA Code:
[/QUOTE]

[QUOTE="bobsan42, post: 5746898, member: 153686"]
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:
VBA Code:
TARGET_ALL "POS Val Target.xls*"
and you can call it again by just changing the filename ...
so in this case, I can get rid of all the "extra subs" for each other POS Validation File, so all I need to do when to
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?
I think I got it:

So don't use
VBA Code:
Public fName as string
but rather only assign fName in one sub

Right now I have a sub for each:
Target_ALL
CAD_CASH_ALL .... etc..

I get rid of all but one sub?:
VBA Code:
Sub POSValidation_ALL_ENTITIES  (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
And call each entity like:
VBA Code:
POSValidation_ALL_ENTITIES "POS Val Target.xls*"
VBA Code:
POSValidation_ALL_ENTITIES "POS Val CAD CASH.xls*"
VBA Code:
POSValidation_ALL_ENTITIES "POS Val CAD CC*"
VBA Code:
POSValidation_ALL_ENTITIES "POS Val US CASH.xls*"
VBA Code:
POSValidation_ALL_ENTITIES "POS Val US CC.xls*"
VBA Code:
POSValidation_ALL_ENTITIES "POS Val eCOM.xls*"
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

bobsan42

Well-known Member
Joined
Jul 14, 2010
Messages
1,855
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
Platform
  1. Windows
Can you expound on the better approach?
Well it is not about better - it is whether you need it there or not.
When a variable is defined in a procedure it only lives within it - when the code exits the variable sort of vanishes. it gets reinitialised when the code is started again.
Otherwise, when defined at the module level, it is still there and has a value after the code ends. So the next code may get it with a wrong or unexpected value. This is useful to keep values in memory and exchange them between pieces of code, but you must be aware how it works.
However, I am not the right person to explain these things. There is plenty written on the Scope of variables.
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,933
Office Version
  1. 2019
Platform
  1. Windows
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?

All programmers have their preferred approach & style when coding but the most basic one I would suggest would be to find some reading material on best practices for declaring variables & their data types.

Dave
 

Forum statistics

Threads
1,148,425
Messages
5,746,603
Members
424,032
Latest member
pochie2741

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top