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:

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
39,164
Office Version
365
Platform
Windows
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
 

Gareth Jones

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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
39,164
Office Version
365
Platform
Windows
Re: VBA Help to passover workbook if not relevant

When it asks for the workbook, just click cancel
 

Gareth Jones

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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
39,164
Office Version
365
Platform
Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,096,444
Messages
5,450,485
Members
405,613
Latest member
Arpit

This Week's Hot Topics

Top