Sub ws_prepare()
Dim wshpost As Worksheet
Dim wshcore As Worksheet
Dim wshvar As Worksheet
Dim wshfac As Range
Dim wshstaff As Worksheet
Dim cnta As Integer
Dim cnt_rec As Integer
Dim cnt_rowsin As Integer
Dim rngRIDCopy As Range
Dim rngcore As Range
Set wshpost = Worksheets("MasterWKSH")
Set wshcore = Worksheets("CONTROL_1")
Set wshvar = Worksheets("varhold")
Set wshstaff = Worksheets("Staff")
Set wshfac = Worksheets("Facilities").Range("A1:G300")
cnt_rec = Application.Count(wshcore.Range("A:A"))
cnt_rowsin = cnt_rec
Set rngRIDCopy = wshcore.Range("A2:A" & cnt_rec + 1)
Set rngcore = wshcore.Range("A:EH")
With wshpost
If .FilterMode Then .ShowAllData
cnta = Application.Count(.Range("A:A"))
If cnta > 0 Then
.Rows("13:" & cnta + 12).Delete
End If
.Rows("13:" & cnt_rec + 12).Insert Shift:=xlDown
With rngRIDCopy
.Copy
End With
.Range("A13").PasteSpecial Paste:=xlPasteValues
For i = 13 To cnt_rec + 12
.Range("C" & i) = Application.VLookup(.Range("A" & i), rngcore, 3, False)
.Range("D" & i) = Application.VLookup(Application.VLookup(.Range("A" & i), rngcore, 10, False), wshfac, 7, False) ' Location
.Range("E" & i) = Application.VLookup(.Range("A" & i), rngcore, 6, False)
.Range("F" & i) = Format(Application.VLookup(.Range("A" & i), rngcore, 14, False), "h:mm A/P")
.Range("G" & i) = Format(Application.VLookup(.Range("A" & i), rngcore, 15, False), "h:mm A/P")
.Range("H" & i) = Application.VLookup(.Range("A" & i), rngcore, 24, False)
.Range("I" & i) = Application.VLookup(.Range("A" & i), rngcore, 31, False)
.Range("J" & i) = Application.VLookup(.Range("A" & i), rngcore, 52, False)
.Range("K" & i) = Application.VLookup(.Range("A" & i), rngcore, 55, False)
.Range("L" & i) = Application.VLookup(.Range("A" & i), rngcore, 58, False)
.Range("M" & i) = Application.VLookup(.Range("A" & i), rngcore, 71, False)
.Range("N" & i) = Application.VLookup(.Range("A" & i), rngcore, 79, False)
.Range("O" & i) = Application.VLookup(.Range("A" & i), rngcore, 87, False)
.Range("P" & i) = Application.VLookup(.Range("A" & i), rngcore, 95, False)
.Range("Q" & i) = Application.VLookup(.Range("A" & i), rngcore, 63, False)
.Range("R" & i) = Application.VLookup(.Range("A" & i), rngcore, 5, False)
Next i
'** SORT **
'.Range("A13:R" & cnt_rec + 12).Sort key1:=Range("R13"), order1:=xlAscending, key2:=Range("F13"), order2:=xlAscending, Header:=xlNo
Dim oRangeSort As Range
Dim oRangeKey As Range
' one range that includes all colums do sort
Set oRangeSort = .Range("A13:R" & cnt_rec + 12)
' start of column with keys to sort
Set oRangeKey = .Range("R13")
' custom sort order
Dim sCustomList(1 To 6) As String
sCustomList(1) = "DT"
sCustomList(2) = "DR"
sCustomList(3) = "FT"
sCustomList(4) = "FR"
sCustomList(5) = "CT"
sCustomList(6) = "CR"
Application.AddCustomList ListArray:=sCustomList
' use this if you want a list on the spreadsheet to sort by
' Application.AddCustomList ListArray:=Range("D1:D3")
.Sort.SortFields.Clear
oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, key2:=Range("F13"), order2:=xlAscending, Header:=xlNo, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
' clean up
'Application.DeleteCustomList Application.CustomListCount
'Set oWorksheet = Nothing
'** MISC **
.Range("O4") = "MSTR"
.Range("M4") = "MIN Start"
.Range("P4") = "MAX End"
.Range("M5") = Application.Min(.Range("F:F"))
.Range("P5") = Application.Max(.Range("G:G"))
'** INSERT SEPARATOR ROWS
'Dim r As Long, mcol As String, h As Long
'r = Cells(Rows.Count, "R").End(xlUp).Row
'mcol = Cells(r, 18).Value
'For h = r To 2 Step -1
' If Cells(h, 18).Value <> mcol Then
' mcol = Cells(h, 18).Value
' Rows(h + 1).Insert
' End If
'Next h
'** PREPARE INDIVIDUAL WORKSHEETS **
Worksheets.Add(After:=Worksheets(13)).Name = "WPL"
'Worksheets.Add(After:=Worksheets(13)).Name = "WPE"
Worksheets.Add(After:=Worksheets(13)).Name = "RPL"
'Worksheets.Add(After:=Worksheets(13)).Name = "RPE"
'Worksheets.Add(After:=Worksheets(13)).Name = "HPL"
'Worksheets.Add(After:=Worksheets(13)).Name = "HPE"
'Worksheets.Add(After:=Worksheets(13)).Name = "CUL"
Worksheets.Add(After:=Worksheets(13)).Name = "CUE"
'** POPULATE WORKSHEETS
.Range("H12") = "Groom"
.Range("I12") = "Prepare"
.Range("J12") = "Signature"
.Range("K12") = "Lights On"
.Range("L12") = "Lights Off"
.Range("M12") = "1"
.Range("N12") = "2"
.Range("O12") = "3"
.Range("P12") = "4"
.Range("Q12") = "Close"
If .FilterMode Then .ShowAllData
llastrow = .Range("R" & Rows.Count).End(xlUp).Row
'RPL
wshvar.Range("I27") = Worksheets("Staff").Range("B18")
With .Range("A12:R" & llastrow)
.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=wshvar.Range("I28:R38"), _
Unique:=False
On Error Resume Next
End With
Worksheets("MasterWKSH").Range("A1:R300").Copy
With Worksheets("RPL")
With .Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteAll
End With
llastrow = .Range("R" & Rows.Count).End(xlUp).Row
With .Rows("1:300")
.RowHeight = 12.75
.VerticalAlignment = xlCenter
End With
.Rows(7).RowHeight = 9.75
.Rows(11).RowHeight = 6
.Rows(llastrow + 3).RowHeight = 6.75
.Rows(llastrow + 5).RowHeight = 6.75
wshwo.Shapes("Picture 3").Copy
Worksheets("RPL").Range("A1").PasteSpecial
.Range("M1") = Format(wshcore.Range("B2"), "dddd, mmmm dd, yyyy")
.Range("M4") = wshvar.Range("I27")
.Range("O4") = Application.VLookup(.Range("M4"), wshstaff.Range("L4:M20"), 2, False)
.Range("P4") = Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 58, False)
.Range("M5") = Format(Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 61, False), "h:mmA/P") & " - " & Format(Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 62, False), "h:mmA/P")
.Range("P5") = Format(Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 59, False), "h:mmA/P") & "-" & Format(Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 60, False), "h:mmA/P")
With .Range("H13:Q" & llastrow)
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=varhold!$I$27"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.499984740745262
End With
With .FormatConditions(1).Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.499984740745262
End With
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=varhold!$I$27"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
End With
End With
End Sub