S.McGuire
S.McGuire

Reputation: 13

Open file if file exists

I have VBA code that opens files based on a date (cell U1) and copies the data before moving on to the next file.

On some days there won't be a file for a specific dataset with that date.

I need to change the code so it checks if the file is there and if not move to the next file.

All sections of the code are the same but have different file paths and names.

    Dim wsAdvantage As Worksheet
    Dim wbkAdvantage As Workbook
    Dim LastRowAdvantage As Integer
    
    Workbooks.Open Filename:="G:\DMT\Aspect Extracts\Daily Extracts\Advantage\2020\" & MonthYear & "\ADV " & DateMonth & ".xlsx"

    Set wsAdvantage = Application.Worksheets("Sheet1")
    
    LastRowAdvantage = wsAdvantage.Range("A" & Rows.Count).End(xlUp).Row

    'Copy the data
    ActiveSheet.Range("A1:C" & LastRowAdvantage).SpecialCells(xlCellTypeVisible).Copy
    
    'Activae Schedule
    For Each wbkSchedule In Workbooks
        If wbkSchedule.Name Like "ScheduleLoaded*" Then
            Windows(wbkSchedule.Name).Activate
            Exit For
        End If
    Next wbkSchedule

    Sheets("Loaded").Select
    
    Range("A1").Select
    
    Selection.End(xlDown).Select
    
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
    
    Range("A1").Select

    Workbooks("ADV " & DateMonth & ".xlsx").Close SaveChanges:=False

Upvotes: 0

Views: 57

Answers (1)

Damian
Damian

Reputation: 5174

This should do the job, if you need help understanding the code, don't hesitate to ask:

Option Explicit
Sub Test()

    'Declare Schedule workbook
    Dim wbkSchedule As Workbook
    Dim wb As Workbook
    For Each wb In Workbooks
        If wbkSchedule.Name Like "ScheduleLoaded*" Then
            Set wbkSchedule = wb
            Exit For
        End If
    Next wbkSchedule

    Dim MyPath As String: MyPath = "G:\DMT\Aspect Extracts\Daily Extracts\Advantage\2020\" & MonthYear & "\"
    Dim MyFile As String
    MyFile = Dir(MyPath & "ADV " & DateMonth & ".xlsx")
    If MyFile = vbNullString Then GoTo NextFile
    Dim wbkAdvantage As Workbook
    Set wbkAdvantage = Workbooks.Open(MyPath & MyFile)
    Dim wsAdvantage As Worksheet
    Set wsAdvantage = wbkAdvantage.Worksheets("Sheet1")


    Dim LastRowAdvantage As Long
    LastRowAdvantage = wsAdvantage.Cells(wsAdvantage.Rows.Count, 1).End(xlUp).Row

    With wbkSchedule.Sheets("Loaded")
        .Range("A1").Resize(LastRowAdvantage, 3).Value = wsAdvantage.Range("A1:C" & LastRowAdvantage).SpecialCells(xlCellTypeVisible).Value
    End With
    wbkAdvantage.Close False
NextFile:

End Sub

Upvotes: 1

Related Questions