VBA Help to pass over workbook if not relevant

Gareth Jones

New Member
Joined
May 16, 2019
Messages
3
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:

Code:
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.
 
Last edited by a moderator:

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Re: VBA Help to passover workbook if not relevant

Try changing this
Code:
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
Code:
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
 
Upvote 0
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.
 
Upvote 0
Re: VBA Help to passover workbook if not relevant

When it asks for the workbook, just click cancel
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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
Back
Top