VBA Help to pass over workbook if not relevant

[Gareth Jones]

Hi all,

New to the forum to post but have used teh information many times, I have teh following to help populate a consolidated workbook which pulls in data from selected workbooks:

Sub PopulateData()


Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wb3 As Workbook
Dim wb4 As Workbook
Dim wb5 As Workbook
Dim wb6 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range


Set wb1 = ActiveWorkbook
Set PasteStart = [EP!A1]


Sheets("EP").Select
    Cells.Select
    Selection.ClearContents


FileToOpen = Application.GetOpenFilename _
(Title:="Please choose the PCR EP Report", _
FileFilter:="Report Files *.xlsx (*.xlsx),")


If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb2 = Workbooks.Open(Filename:=FileToOpen)
Application.DisplayAlerts = False
    For Each Sheet In wb2.Sheets
        With Sheet.UsedRange
            Rows("1:1").Select
    Selection.Delete Shift:=xlUp
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet


End If


    wb2.Close
    
Application.DisplayAlerts = True
Set wb1 = ActiveWorkbook
Set PasteStart = [Committed!A1]


Sheets("Committed").Select
    Cells.Select
    Selection.ClearContents


FileToOpen = Application.GetOpenFilename _
(Title:="Please choose the PCR Committed Report", _
FileFilter:="Report Files *.xlsx (*.xlsx),")


If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb3 = Workbooks.Open(Filename:=FileToOpen)
Application.DisplayAlerts = False
    For Each Sheet In wb3.Sheets
        With Sheet.UsedRange
            Rows("1:1").Select
    Selection.Delete Shift:=xlUp
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet


End If


    wb3.Close
Application.DisplayAlerts = True


Set wb1 = ActiveWorkbook
Set PasteStart = [Risk!A1]


Sheets("Risk").Select
    Cells.Select
    Selection.ClearContents
    
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose the PCR Risk Report", _
FileFilter:="Report Files *.xlsx (*.xlsx),")


If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb4 = Workbooks.Open(Filename:=FileToOpen)


    Application.DisplayAlerts = False
    For Each Sheet In wb4.Sheets
        With Sheet.UsedRange
            Rows("1:1").Select
    Selection.Delete Shift:=xlUp
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet


End If


    wb4.Close
Application.DisplayAlerts = True
    
    Set wb1 = ActiveWorkbook
Set PasteStart = [EPVar!A1]


Sheets("EPVar").Select
    Cells.Select
    Selection.ClearContents
    
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose the PCR EP Variance Report", _
FileFilter:="Report Files *.xlsx (*.xlsx),")


If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb5 = Workbooks.Open(Filename:=FileToOpen)
    
    Application.DisplayAlerts = False
    For Each Sheet In wb5.Sheets
        With Sheet.UsedRange
            Rows("1:1").Select
    Selection.Delete Shift:=xlUp
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet
    
End If


    wb5.Close
Application.DisplayAlerts = True
    
     Set wb1 = ActiveWorkbook
Set PasteStart = [EPRMC!A1]


Sheets("EPRMC").Select
    Cells.Select
    Selection.ClearContents
    
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose the PCR EP RMC Report", _
FileFilter:="Report Files *.xlsx (*.xlsx),")


If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb6 = Workbooks.Open(Filename:=FileToOpen)
    
    Application.DisplayAlerts = False
    For Each Sheet In wb6.Sheets
        With Sheet.UsedRange
            Rows("1:1").Select
    Selection.Delete Shift:=xlUp
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet


End If


    wb6.Close
Application.DisplayAlerts = True
    
     Set wb1 = ActiveWorkbook
Set PasteStart = [RMCRACData!A1]


Sheets("RMCRACData").Select
    Cells.Select
    Selection.ClearContents
    
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose the PCR EP RMC Report by RAC", _
FileFilter:="Report Files *.xlsx (*.xlsx),")


If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb7 = Workbooks.Open(Filename:=FileToOpen)
    
    Application.DisplayAlerts = False
    For Each Sheet In wb7.Sheets
        With Sheet.UsedRange
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet


End If


    wb7.Close

My question is that not all teams will have WB6 and 7 is there a way I can insert code so the user can choose to select a workbook or not select so it then moves on the next part of the code.

Thanks in advance as any help would be appreciated.

 

[Fluff]

Re: VBA Help to passover workbook if not relevant

Try changing this

If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb6 = Workbooks.Open(Filename:=FileToOpen)
    
    Application.DisplayAlerts = False
    For Each Sheet In wb6.Sheets
        With Sheet.UsedRange
            Rows("1:1").Select
    Selection.Delete Shift:=xlUp
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet


End If


    wb6.Close

to

If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
   
Else
    Set wb6 = Workbooks.Open(Filename:=FileToOpen)
    
    Application.DisplayAlerts = False
    For Each Sheet In wb6.Sheets
        With Sheet.UsedRange
            Rows("1:1").Select
    Selection.Delete Shift:=xlUp
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet

 wb6.Close
End If

 

[Gareth Jones]

Re: VBA Help to passover workbook if not relevant

Thanks Fluff - with that amendment would I not still have to select the file, I would like the options of saying there is no file. The VBA runs okay when the file contains no data but the final file size jumps to 212MB due the the copy and paste to the last row of excel which is way down at 130k lines.

 

[Fluff]

Re: VBA Help to passover workbook if not relevant

When it asks for the workbook, just click cancel

 

[Gareth Jones]

Re: VBA Help to passover workbook if not relevant

Then the VBA would debug and error due to the code, so I guess I need a skip if cancelled and to carry on with the next step?

 

[Fluff]

Re: VBA Help to passover workbook if not relevant

The code should not crash, if you done as I suggested.
You will simply get the message box & then you will be asked for the next file.