Results 1 to 6 of 6

Thread: VBA Help to pass over workbook if not relevant
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    May 2019
    Posts
    3
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA Help to pass over workbook if not relevant

    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 Fluff; May 16th, 2019 at 09:52 AM. Reason: Code tags

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    22,886
    Post Thanks / Like
    Mentioned
    385 Post(s)
    Tagged
    41 Thread(s)

    Default 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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 2003 & 2013 on Win 7

  3. #3
    New Member
    Join Date
    May 2019
    Posts
    3
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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.

  4. #4
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    22,886
    Post Thanks / Like
    Mentioned
    385 Post(s)
    Tagged
    41 Thread(s)

    Default Re: VBA Help to passover workbook if not relevant

    When it asks for the workbook, just click cancel
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 2003 & 2013 on Win 7

  5. #5
    New Member
    Join Date
    May 2019
    Posts
    3
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default 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?

  6. #6
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    22,886
    Post Thanks / Like
    Mentioned
    385 Post(s)
    Tagged
    41 Thread(s)

    Default 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.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 2003 & 2013 on Win 7

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •