PhosFeedLogisticsMan
New Member
- 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
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: