Satorsunonfriormon = Worksheets( Vacation Req. ).Cells(1, 10)

FunctionDayName(dateval)

DimSATorSUNonFRIorMONAsBoolean

DimTHANKSGIVfridayAsBoolean

SATorSUNonFRIorMON = Worksheets("Vacation Req.").Cells(1, 10)

THANKSGIVfriday = Worksheets("Vacation Req.").Cells(2, 10)

'Christmas

If Month(dateval) = 12 Then

IfSATorSUNonFRIorMONThen

If Day(dateval) = 25 Then

If Weekday(dateval) > 1 And Weekday(dateval) > 7 Then

GoTo holiday

EndIf

ElseIf Day(dateval) = 26 Then

If Weekday(DateSerial(Year(dateval), 12, 25)) = 1 Then

GoTo holiday

EndIf

ElseIf Day(dateval) = 24 Then

If Weekday(DateSerial(Year(dateval), 12, 25)) = 7 Then

GoTo holiday

EndIf

ElseIf Month(dateval) = 12 Then

If Day(dateval) = 31 Then

If Weekday(DateSerial(Year(dateval) + 1, 1, 1)) = 7 Then

GoTo holiday

EndIf

ElseIf Day(dateval) = 25 Then

GoTo holiday

EndIf

'if Tuesday Christmas then Monday is also a holiday

If Day(dateval) = 24 And Weekday(DateSerial(Year(dateval), 12, 25)) = 3 Then

GoTo holiday

EndIf

'If Day(dateval) = 26 And WeekDay(DateSerial(Year(dateval), 12, 25)) = 5 Then

'GoTo holiday

' End If

'New Years

ElseIf Month(dateval) = 1 Then

IfSATorSUNonFRIorMONThen

If Day(dateval) = 1 Then

If Weekday(dateval) > 1 And Weekday(dateval) > 7 Then

GoTo holiday

EndIf

ElseIf Day(dateval) = 2 Then

If Weekday(DateSerial(Year(dateval), 1, 1)) = 1 Then

GoTo holiday

EndIf

ElseIf Day(dateval) = 1 Then

GoTo holiday

EndIf

'Thanksgiving

ElseIf Month(dateval) = 11 Then

If Weekday(DateSerial(Year(dateval), 11, 1)) > 5 Then

If 34 - Weekday(DateSerial(Year(dateval), 11, 1)) = Day(dateval) Then

GoTo holiday

ElseIfTHANKSGIVfridayAnd 34 - Weekday(DateSerial(Year(dateval), 11, 1)) = Day(dateval - 1) Then

GoTo holiday

EndIf

ElseIf Weekday(DateSerial(Year(dateval), 11, 1)) < 6 Then

If 27 - Weekday(DateSerial(Year(dateval), 11, 1)) = Day(dateval) Then

GoTo holiday

ElseIfTHANKSGIVfridayAnd 27 - Weekday(DateSerial(Year(dateval), 11, 1)) = Day(dateval - 1) Then

GoTo holiday

EndIf

'4th of July

ElseIf Month(dateval) = 7 Then

IfSATorSUNonFRIorMONThen

If Day(dateval) = 4 Then

If Weekday(dateval) > 1 And Weekday(dateval) > 7 Then

GoTo holiday

EndIf

ElseIf Day(dateval) = 5 Then

If Weekday(DateSerial(Year(dateval), 7, 4)) = 1 Then

GoTo holiday

EndIf

ElseIf Day(dateval) = 3 Then

If Weekday(DateSerial(Year(dateval), 7, 4)) = 7 Then

GoTo holiday

EndIf

ElseIf Day(dateval) = 4 Then

GoTo holiday

EndIf

'Labor Day

ElseIf Month(dateval) = 9 Then

If Weekday(DateSerial(Year(dateval), 9, 1)) > 2 Then

If 10 - Weekday(DateSerial(Year(dateval), 9, 1)) = Day(dateval) Then

GoTo holiday

EndIf

ElseIf Weekday(DateSerial(Year(dateval), 9, 1)) < 3 Then

If 3 - Weekday(DateSerial(Year(dateval), 9, 1)) = Day(dateval) Then

GoTo holiday

EndIf

'Memorial Day

ElseIf Month(dateval) = 5 Then

If Weekday(DateSerial(Year(dateval), 5, 31)) = 1 Then

If 25 = Day(dateval) Then

GoTo holiday

EndIf

ElseIf Weekday(DateSerial(Year(dateval), 5, 31)) > 1 Then

If 33 - Weekday(DateSerial(Year(dateval), 5, 31)) = Day(dateval) Then

GoTo holiday

EndIf

'Presidents Day

'ElseIf Month(dateval) = 2 Then

'If Weekday(DateSerial(Year(dateval), 2, 28)) = 1 Then

'If 15 = Day(dateval) Then

'GoTo holiday

'End If

'ElseIf Weekday(DateSerial(Year(dateval), 2, 28)) > 1 Then

'If 23 - Weekday(DateSerial(Year(dateval), 2, 28)) = Day(dateval) Then

'GoTo holiday

'End If

EndIf

SelectCase Weekday(dateval)

Case 1

DayName = "Sun"

Case 2

DayName = "Mon"

Case 3

DayName = "Tue"

Case 4

DayName = "Wed"

Case 5

DayName = "Thu"

Case 6

DayName = "Fri"

Case 7

DayName = "Sat"

EndSelect

GoTo quit

holiday: DayName = "HOL"

quit:

EndFunction

FunctiondayNUM(firstday, lastday)

totalnum = 0

testday = firstday

Whiletestday <= lastday

SelectCaseDayName(testday)

Case "Mon", "Tue", "Wed", "Thu", "Fri"

totalnum = totalnum + 1

EndSelect

testday = testday + 1

Wend

dayNUM = totalnum

EndFunction

FunctionMonthText(monthNUMAsSingle)

SelectCasemonthNUM

Case 1

MonthText = "January"

Case 2

MonthText = "February"

Case 3

MonthText = "March"

Case 4

MonthText = "April"

Case 5

MonthText = "May"

Case 6

MonthText = "June"

Case 7

MonthText = "July"

Case 8

MonthText = "August"

Case 9

MonthText = "September"

Case 10

MonthText = "October"

Case 11

MonthText = "November"

Case 12

MonthText = "December"

EndSelect

EndFunction

SubNew_Month_Template()

DimnewYEARAsVariant

DimnewMONTHAsString

DimmonthNUMAsSingle

DimmonthNUMtextAsString

DimOldWorkbookNAME, NewWorkbookNAMEAsString

DimforceCALCAsString

DimNewWorkbookPATHAsString

DimmergeROW, mergeCOL, mergeWEEKAsSingle

Application.ScreenUpdating = False

OldWorkbookNAME = ActiveWorkbook.Path & "/" & ActiveWorkbook.Name

newYEAR = Year(Worksheets("Current Month").Cells(3, 3) + 40)

monthNUM = Month(Worksheets("Current Month").Cells(3, 3) + 40)

newMONTH = MonthText(monthNUM)

msg = "Do you want to CHANGE the 'Current Month' Calendar to " & newMONTH & ", " & newYEAR & "?"

Style = vbYesNoCancel + vbDefaultButton2

Title = "New Current Month?"

response = MsgBox(msg, Style, Title)

If response = vbYesThen

IfMonth(Worksheets("Current Month").Cells(4, 7) + 40) > Month(Worksheets("Vacation Req.").Cells(16, 3)) Or Year(Worksheets("Current Month").Cells(4, 7) + 40) > Year(Worksheets("Vacation Req.").Cells(16, 3)) Then

Worksheets("Vacation Req.").Activate

MsgBox ("The Vacation & Schedule Requestsmust be appropriately updated (in the Vacation Req. Sheet) to containthe " & newMONTH & " vacation requests before starting the " & newMONTH & " Schedule!")

ExitSub

EndIf

IfmonthNUM < 10 Then

monthNUMtext = "0" & monthNUM

Else

monthNUMtext = monthNUM

EndIf

NewWorkbookNAME = newYEAR & "-" & monthNUMtext & ", " & newMONTH & " Call Schedule"

NewWorkbookPATH = ActiveWorkbook.Path

ActiveWorkbook.SaveAsFilename:=NewWorkbookPATH & "\" & NewWorkbookNAME, _

FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _

ReadOnlyRecommended:=False, CreateBackup:=True

ElseIf response = vbCancelThenExitSub

Else

msg = "Do you want to leave the 'Current Month' as " & Month(Sheets("Current Month").Cells(8, 5) + 7) & "/" & Year(Sheets("Current Month").Cells(8, 5) + 7) & " and simply erase calendar entries?"

Style = vbYesNo + vbDefaultButton2

Title = "Same Current Month?"

response = MsgBox(msg, Style, Title)

If response = vbYesThen

IfMonth(Worksheets("Current Month").Cells(8, 5) + 40) > Month(Worksheets("Vacation Req.").Cells(22, 3)) And Year(Worksheets("Current Month").Cells(8, 5) + 40) > Year(Worksheets("Vacation Req.").Cells(22, 3)) Then

Worksheets("Vacation Req.").Activate

MsgBox ("The Vacation & Schedule Requests Must Be Updated Before Starting A New Schedule")

ExitSub

EndIf

msg = "Entries in the 'Current Month' Calendar will be erased.Do you wish to continue?"

response = MsgBox(msg, vbYesNo + vbDefaultButton2, "CAUTION!")

If response = vbNoThenExitSub

Else

ExitSub

EndIf

Application.Calculation = xlAutomatic

'COPY TEMPLATE TO CURRENT MONTH

Worksheets("Template").Unprotect

Worksheets("Current Month").Unprotect

Worksheets("Current Month").Cells(3, 3) = Worksheets("Current Month").Cells(4, 3) + 1

Worksheets("Template").Select

Range("F3:AC57").Select

Selection.Copy

Worksheets("Current Month").Select

Range("F3").Select

Selection.PasteSpecialPaste:=xlPasteValues

Selection.PasteSpecialPaste:=xlPasteFormats

Sheets("Template").Select

Range("H4:AA10").Select

Selection.Copy

Worksheets("Current Month").Select

Range("H4,H15,H26,H37").Select

ActiveSheet.Paste

Application.Calculation = xlAutomatic

Worksheets("Web Version").Unprotect

Worksheets("Current Month").Unprotect

Worksheets("Current Month").Select

IfCells(5, 3) = 4 Then

Range("F47:AC57").Select

Selection.ClearContents

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

WithSelection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

.PatternTintAndShade = 0

EndWith

Sheets("Template").Select

Range("E139:AB194").Select

Selection.Copy

Sheets("Web Version").Select

Range("B3").Select

ActiveSheet.Paste

Else

Sheets("Template").Select

Range("E72:AB127").Select

Selection.Copy

Sheets("Web Version").Select

Range("B3").Select

ActiveSheet.Paste

EndIf

Worksheets("Web Version").Protect

Worksheets("Vacation Req.").Select

Range("A1").Select

Worksheets("Template").Select

Range("A1").Select

Worksheets("Template").Protect

Sheets("Current Month").Select

Range("A1").Select

Sheets("Current Month").Protect

Range("C15").Select

Selection.ClearContents

Application.ScreenUpdating = True

Application.Calculation = xlAutomatic

ActiveWorkbook.Save

MsgBox ("Update links to: " & OldWorkbookNAME)

Sheets("Current Month").Unprotect

Application.Dialogs(xlDialogOpenLinks).Show

Sheets("Current Month").Protect

Application.ScreenUpdating = True

EndSub