VBA Skipping File Names that do not exist - excel

Question

I am working on a code for my company that would take our production relief sheets and compile the data into one big document for compiling. I have a code that runs and does what I need it do; however, I have run into a problem. Our relief sheets are saved to our ShareDrive with the name of the current date (example: "4-27-2022"). Our site does not work on Saturdays or Sundays; therefore, we do not have relief sheets for Saturdays or Sundays. The code below works for importing data from a Monday-Friday, but it doesn't work if you want to look at dates that are separated by a weekend.
Is there a way to get excel to run my current code but skip the dates that do not have a file?
code:
Option Explicit
Sub ImportPolymerData()
'This sub imports the data from the polymer relief sheets based on the date range specified.
Dim StartDate As String, EndDate As String, SMonth As Integer, EMonth As Integer, d As String, dt As String
Dim StartY As String, SShortY As String, EndY As String, ShortEndY As String
Dim diff As Integer
Dim wbRS As Workbook 'Relief Sheet workbook
Dim wb As Workbook
Dim rng As Range
Dim r As Range
Dim dat As String
Dim i As Integer
Set wb = ThisWorkbook
Dim myPath As String
Dim myFile As String
Dim Dmonth As Integer
Application.ScreenUpdating = False
wb.Sheets("Inputs").Activate
StartDate = Range("B4").Value 'Pulls the start and end date out of cells B4 and B5
EndDate = Range("B5").Value
SMonth = Month(StartDate) 'Pulls the Month of the start and end date
EMonth = Month(EndDate)
StartY = Year(StartDate) 'Pulls the Year of the start and end date
EndY = Year(EndDate)
SShortY = Right(StartY, 2) 'Pulls the last two numbers of the year of the start and end date
ShortEndY = Right(EndY, 2)
'''Update FilePath after New Year'''
myPath = "\\cx.championx.com\AMER\US-Garyville\Groups\Champion X Operators\Polymer Relief Sheets\Polymer Relief Sheet Current\" & StartY
'Get date range difference
diff = DateDiff("d", StartDate, EndDate) 'Counts the number of days between the start and end date
'This will be the end of the loop for looping through the files
'MsgBox diff
'Clear Old Data
wb.Sheets("5B Polymer").Activate
wb.Sheets("5B Polymer").Range(Range("A2").End(xlToRight), Range("A2").End(xlDown)).Clear
On Error Resume Next 'tells excel to skip lines of code containing errors
'Loop through files
For i = 0 To diff 'From 0 to the # of days in the range of start date to end date
dat = wb.Sheets("Inputs").Range("B4").Value + i
Dmonth = Month(dat) 'Gets the month for whatever date you have going through the loop
'Format "dat" to find the Polymer Relief Sheet file
dt = Format(dat, "mm/dd/yyyy") 'Changes the date format to match the way dates are entered as relief sheet titles
d = Replace(dt, "/", "-")
'MsgBox d
'Opens the Relief sheet folder with the month of the dates
Select Case Dmonth
Case 1
myFile = myPath & "\01-JAN\" & d & ".xlsm"
Case 2
myFile = myPath & "\02-FEB\" & d & ".xlsm"
Case 3
myFile = myPath & "\03-MAR\" & d & ".xlsm"
Case 4
myFile = myPath & "\04-APR\" & d & ".xlsm"
Case 5
myFile = myPath & "\05-MAY\" & d & ".xlsm"
Case 6
myFile = myPath & "\06-JUN\" & d & ".xlsm"
Case 7
myFile = myPath & "\07-JUL\" & d & ".xlsm"
Case 8
myFile = myPath & "\08-AUG\" & d & ".xlsm"
Case 9
myFile = myPath & "\09-SEP\" & d & ".xlsm"
Case 10
myFile = myPath & "\10-OCT\" & d & ".xlsm"
Case 11
myFile = myPath & "\11-NOV\" & d & ".xlsm"
Case 12
myFile = myPath & "\12-DEC\" & d & ".xlsm"
End Select
'Open up
Set wbRS = Workbooks.Open(myFile)
'Unhides all hidden worksheets in the relief sheet workbook
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
'Get polymer data
wbRS.Sheets("5B Batches").Activate
Application.CutCopyMode = False
'Range(range("A2").end (xltoright), range("A2").end(xldown)).select
Range(Range("A2").End(xlToRight), Range("A2").End(xlDown)).Copy
With wb.Sheets("5B Polymer")
If .Range("A2") = "" Then
.Range("A2").PasteSpecial Paste:=xlPasteValues
Else
.Range("A2").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If
Columns("A:A").Select
Selection.NumberFormat = "m/d/yyyy"
End With
Application.CutCopyMode = False
'save and close
wbRS.Close False
Next i
wb.Sheets("5B Polymer").Activate
Columns("A:A").Select
Selection.NumberFormat = "m/d/yyyy"
Range("A2").Select
Sheets("Inputs").Range("I2").Value = Now
End Sub
Any help is greatly appreciated!

Answer 1

Make sure you don't use Select and Activate
see How to avoid using Select in Excel VBA
Instead make sure you have all Range, Cells, Columns and Rows objects fully referenced to a workbook and worksheet
Never use On Error Resume Next to hide all error messages. Your code cannot work properly then (if it works it works only by accident but not on purpose). Use this line only to handle an expected error and always turn on error reporting right after that expected error as I did when opening the file. Here we expect that opening a file can error because a file does not exist. So we handle that by testing for Nothing to see if the file was opened.
Option Explicit
Public Sub ImportPolymerData()
'This sub imports the data from the polymer relief sheets based on the date range specified.
' Application.ScreenUpdating = False 'either turn it on in the end or leave it out. If you reference everything properly and don't use Select you don't need that.
Dim wb As Workbook
Set wb = ThisWorkbook
Dim StartDate As String
StartDate = wb.Sheets("Inputs").Range("B4").Value 'Pulls the start and end date out of cells B4 and B5
Dim EndDate As String
EndDate = wb.Sheets("Inputs").Range("B5").Value
Dim SMonth As Long
SMonth = Month(StartDate) 'Pulls the Month of the start and end date
Dim EMonth As Long
EMonth = Month(EndDate)
Dim StartY As String
StartY = Year(StartDate) 'Pulls the Year of the start and end date
Dim EndY As String
EndY = Year(EndDate)
Dim SShortY As String
SShortY = Right(StartY, 2) 'Pulls the last two numbers of the year of the start and end date
Dim ShortEndY As String
ShortEndY = Right(EndY, 2)
'''Update FilePath after New Year'''
Dim myPath As String
myPath = "\\cx.championx.com\AMER\US-Garyville\Groups\Champion X Operators\Polymer Relief Sheets\Polymer Relief Sheet Current\" & StartY
'Get date range difference
Dim diff As Long
diff = DateDiff("d", StartDate, EndDate) 'Counts the number of days between the start and end date
'This will be the end of the loop for looping through the files
'Clear Old Data
With wb.Sheets("5B Polymer")
.Range(.Range("A2").End(xlToRight), .Range("A2").End(xlDown)).Clear
End With
'don't do that without proper error handling!!!
'On Error Resume Next 'tells excel to skip lines of code containing errors
'Loop through files
Dim i As Long
For i = 0 To diff 'From 0 to the # of days in the range of start date to end date
Dim dat As String
dat = wb.Worksheets("Inputs").Range("B4").Value + i
Dim Dmonth As Long
Dmonth = Month(dat) 'Gets the month for whatever date you have going through the loop
'Format "dat" to find the Polymer Relief Sheet file
Dim dt As String
dt = Format$(dat, "mm/dd/yyyy") 'Changes the date format to match the way dates are entered as relief sheet titles
Dim d As String
d = Replace$(dt, "/", "-")
'Opens the Relief sheet folder with the month of the dates
Dim MonthFolders As Variant
MonthFolders = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
'create file path and file name
Dim myFile As String
myFile = myPath & "\" & Format$(Dmonth, "00") & "-" & MonthFolders(Dmonth - 1) & "\" & d & ".xlsm"
'Try to open the file
Dim wbRS As Workbook 'Relief Sheet workbook
Set wbRS = Nothing
On Error Resume Next ' hide error just in next line!
Set wbRS = Workbooks.Open(myFile)
On Error GoTo 0 ' re-activate error reporting!!!
'run the following only if the file could be opened otherwise it does not exist
If Not wbRS Is Nothing Then
'Unhides all hidden worksheets in the relief sheet workbook
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
'Get polymer data
Application.CutCopyMode = False
With wbRS.Worksheets("5B Batches")
.Range(.Range("A2").End(xlToRight), .Range("A2").End(xlDown)).Copy
End With
With wb.Worksheets("5B Polymer")
If .Range("A2") = vbNullString Then
.Range("A2").PasteSpecial Paste:=xlPasteValues
Else
.Range("A2").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If
wbRS.Worksheets("5B Batches").Columns("A:A").NumberFormat = "m/d/yyyy"
End With
Application.CutCopyMode = False
'!!! you don't save here!!! your comment is wrong or it needs to be SaveChanges:=True
'save and close
wbRS.Close SaveChanges:=False
End If
Next i
wb.Worksheets("5B Polymer").Columns("A:A").NumberFormat = "m/d/yyyy"
wb.Worksheets("Inputs").Range("I2").Value = Now
End Sub