VBA Skipping File Names that do not exist

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