Don't include specific worksheets in Loop

Joined
Aug 9, 2017
Messages
17
I am not the greatest at VBA, and I am just calling myself out prior, that I'm a VBA hack, still trying to learn- so don't judge the code you are about to see with the exception of what I had help on lol. Forget it, you can judge, I will accept the abuse if I can get some help.

I have a workbook in which I want other users to print specific worksheets, which end up as a new work book. I am trying to simplify/dummie proof the process for the users. I am needing to add a menu clickable buttons, and a few other items, so the entire process of creating this schedule is done within the workbook. The issue comes when I try to add other sheets to my workbook, then my code doesn't quite work right. Here is what I am trying to do, there are 4 sheets in the work book that I need to print after they select the dates (from another code that calls the one I am about to post), it then looks at the sheets in the workbook and creates a new workbook with my 4 sheets. How, if I add a few more sheets (which do not have dates in column 2, and do not need to be added to the new workbook) can I ignore these sheets so they don't get added to the new workbook. Currently it looks like it loops, and looks at Each wks. I want it to look at only the sheets named below, and only use those as the output to the new workbook...

"ShiftSupers_Chiefs_PO"
"Loaders_Unloaders"
"Payload Operator"
"Rail"


'This subroutine creates the new workbook based on input from the prompts
VBA Code:
Public Sub CreateSubsetWorkbook(StartDate As String, EndDate As String)
    Application.ScreenUpdating = False
    Dim wbkOutput As Workbook
    Dim wksOutput As Worksheet, wks As Worksheet
    Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long
    Dim rngFull As Range, rngResult As Range, rngTarget As Range
   
    'Set references up-front
    lngDateCol = 2 '<~ we know dates are in column C
    Set wbkOutput = Workbooks.Add
    'ActiveWorkbook.SaveAs Filename:="C:\Users\egabel\Documents\Shift Schedule\MHWeeklySchedule.xlsx"
    Application.GetSaveAsFilename

    'Loop through each worksheet
    For Each wks In ThisWorkbook.Worksheets
        With wks
       
       
       
            'Create a new worksheet in the output workbook
            Set wksOutput = wbkOutput.Sheets.Add
            wksOutput.Name = wks.Name
           
            'Create a destination range on the new worksheet that we
            'will copy our filtered data to
            Set rngTarget = wksOutput.Cells(5, 1)
       
            'Identify the data range on this sheet for the autofilter step
            'by finding the last row and the last column
            lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row
            lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column
            Set rngFull = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))
           
            'Apply a filter to the full range to get only rows that
            'are in between the input dates
            With rngFull
                .AutoFilter Field:=lngDateCol, _
                            Criteria1:=">=" & StartDate, _
                            Criteria2:="<=" & EndDate
               
                'Copy only the visible cells and paste to the
                'new worksheet in our output workbook
                Set rngResult = rngFull.SpecialCells(xlCellTypeVisible)
                rngResult.Copy Destination:=rngTarget
            End With
           
            'Clear the autofilter safely
            .AutoFilterMode = False
            If .FilterMode = True Then
                .ShowAllData
            End If
        End With
    Next wks
   

    Application.DisplayAlerts = False
    Worksheets("RotateIndex").Delete
    Worksheets("sheet1").Delete
    Worksheets("sheet2").Delete
    Worksheets("sheet3").Delete
    Application.DisplayAlerts = True
   
    Workbooks("MH_Shift_Scheduler.xlsm").Worksheets("ShiftSupers_Chiefs_PO").Range("A1:AC5").Copy _
    Worksheets("ShiftSupers_Chiefs_PO").Range("A1:AC5")
    Worksheets("ShiftSupers_Chiefs_PO").Columns("B:B").EntireColumn.AutoFit
   
    Workbooks("MH_Shift_Scheduler.xlsm").Worksheets("Loaders_Unloaders").Range("A1:AG5").Copy _
    Worksheets("Loaders_Unloaders").Range("A1:AG5")
    Worksheets("Loaders_Unloaders").Columns("B:B").EntireColumn.AutoFit
   
    Workbooks("MH_Shift_Scheduler.xlsm").Worksheets("Payload Operator").Range("A1:N5").Copy _
    Worksheets("Payload Operator").Range("A1:N5")
    Worksheets("Payload Operator").Columns("B:B").EntireColumn.AutoFit
   
    Workbooks("MH_Shift_Scheduler.xlsm").Worksheets("Rail").Range("A1:W5").Copy _
    Worksheets("Rail").Range("A1:W5")
    Worksheets("Rail").Columns("B:B").EntireColumn.AutoFit
   
   

  
   
Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,515
Office Version
  1. 365
Platform
  1. Windows
Store the worksheets you want to include in an Array, and loop through those.
See here for an example (I would ignore the first reply, and look at the ones after that for various ways of doing that):
 
Joined
Aug 9, 2017
Messages
17
Store the worksheets you want to include in an Array, and loop through those.
See here for an example (I would ignore the first reply, and look at the ones after that for various ways of doing that):
Will do .. thanks!
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,515
Office Version
  1. 365
Platform
  1. Windows
You are welcome.
 

Forum statistics

Threads
1,144,567
Messages
5,725,028
Members
422,589
Latest member
JohnnyBravo1

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
Top