Sub dist_create()
'Stop
Application.ScreenUpdating = False
Dim filePath As String
Dim tc As Boolean
Dim CList(1 To 5) As String
Dim rw As Integer
Dim sh As Worksheet
Dim bLeft, bRight, c As Range
Dim arrFolders() As String
Dim i As Integer
Dim strPath As String
'setup sheets staff
'check if distributables have been prepared already
'Stop
mntxt = MonthName(Month(inq_date))
daytext = WeekdayName(Weekday(inq_date), True)
crtyr = Year(Now)
filePath = distpath & crtyr & "\" & mntxt & "\" & Format(Day(inq_date), "00") & " " & UCase(daytext) & "\"
nfn = "WS " & Format(inq_date, "dd-mmm-yy") & ".xlsx"
If FolderExists(filePath) = False Then
ui1 = MsgBox("Distributables file for " & Format(inq_date, "dddd mmm-dd") & " does not exist." & Chr(13) & "Create now?", vbInformation + vbYesNo, "Distributables Folder")
If ui1 = vbYes Then
Debug.Print filePath
Call subCreateFolders(filePath)
Else
Exit Sub
End If
Else
'ui1 = MsgBox("Distributables Folder Exists" & Chr(13) & filePath & Chr(13) & "[YES] to review; [NO] to recreate", vbInformation + vbYesNoCancel, "Distributables Folder")
'If ui1 = vbYes Then
' Stop
'ElseIf ui1 = vbNo Then
' Stop
'End If
End If
'create and save new target workbook
filePath = filePath & nfn
If FileExists(filePath) = True Then Kill (filePath) 'delete previous file for now
Workbooks.Add.SaveAs Filename:=filePath
Set wb_daily = Workbooks(nfn)
'copy sheets
arrNames = Array("MASTER", "EVL", "EVE", "LWP", "WPL", "WPE", "RPL", "RPE", "HPL", "HPE", "BPL", "BPE", "CUL", "CUE2", "CUE1", "CWP", "CRP", "LSP")
'create raw sheets
'Stop
For i = 0 To 17
shnm = arrNames(i)
Debug.Print shnm
Set ssh = Nothing
On Error Resume Next
Set ssh = ThisWorkbook.Sheets("Master")
On Error GoTo 0
If Not ssh Is Nothing Then
ssh.Copy After:=wb_daily.Sheets(1)
ActiveSheet.Name = shnm
'sheets are hidden
End If
If shnm <> "MASTER" Then
Stop
With ActiveSheet
.Unprotect
'eliminate buttons
With ActiveSheet.Columns("Q:AG")
For Each shp In .Parent.Shapes
If Not Intersect(shp.TopLeftCell, .Cells) Is Nothing Then shp.Delete
Next shp
End With
With ActiveSheet.Range("D1:R9")
For Each shp In .Parent.Shapes
If Not Intersect(shp.TopLeftCell, .Cells) Is Nothing Then shp.Delete
Next shp
End With
'eliminate staffing range
.Columns("S:AG").Clear
.Range("O4") = ActiveSheet.Name
.Protect
End With
End If
Next i
'Stop
'set worksheets
Set ws_dmaster = wb_daily.Worksheets("MASTER")
Set ws_evl = wb_daily.Worksheets("EVL")
Set ws_eve = wb_daily.Worksheets("EVE")
Set ws_lwp = wb_daily.Worksheets("LWP")
Set ws_wpl = wb_daily.Worksheets("WPL")
Set ws_wpe = wb_daily.Worksheets("WPE")
Set ws_rpl = wb_daily.Worksheets("RPL")
Set ws_rpe = wb_daily.Worksheets("RPE")
Set ws_hpl = wb_daily.Worksheets("HPL")
Set ws_hpe = wb_daily.Worksheets("HPE")
Set ws_bpl = wb_daily.Worksheets("BPL")
Set ws_bpe = wb_daily.Worksheets("BPE")
Set ws_cul = wb_daily.Worksheets("CUL")
Set ws_cue2 = wb_daily.Worksheets("CUE2")
Set ws_cuel = wb_daily.Worksheets("CUE1")
Set ws_wrp = wb_daily.Worksheets("CWP")
Set ws_crp = wb_daily.Worksheets("CRP")
Set ws_lsp = wb_daily.Worksheets("LSP")
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = False
'refine individual crew sheets
'... ... ... more code follows
