Sep 14 2021 07:37 PM
Greetings Excel Programmers,
I've been experiencing a periodic error while testing code to one of my UserForms that causes Excel to crash without saving my work.
It's not all the time, or even most of the time, but happens particularly if I've reopened after previously having it open (and ran or partially ran) before. It can be the initializing event or clicking a button inside it or such as. Therefore, while I do have all 3,921 code lines of it doing what I need perfectly, I currently deem the overall UserForm not fully reliable due to the seemingly random error.
This is the UserForm (following the click of my button) working fine:
Any thoughts on what could cause this error and what it is? Anything helps and I'd love to be educated! ^_^
Thanks!
Sep 15 2021 03:16 AM
Without the file, it is very difficult to determine where this might be coming from.
You would have to guide the VBA code step by step to see where the code stops or where the suspected error can be.
stepped through it (you can use F8).
if you take out userform.showfrom your code, everything works?
Here is some information if the error is in the user form.
VBA: "Automation Error. Exception occurred." when using UserForm
Another suggestion that involves a lot of work,
Copy the user form and all sheets into the new workbook.
I hope that I could help you with this information in your projects.
NikolinoDE
I know I don't know anything (Socrates)
Sep 15 2021 04:05 PM
Sep 15 2021 04:14 PM
@NikolinoDE, I mean ... here's the code to my UserForm (even though it's vague not knowing the buttons/labels/textboxes or applications), if anything in it could possibly be a red flag for the error and one could spare a little time to help. ^_^
Public CancelLoad As Integer
Public New_Start_Date As String, Start_Date_IsPrev As String, Start_Date_IsNext As String
Public New_End_Date As String, End_Date_IsPrev As String, End_Date_IsNext As String
Private Sub CommandButton3_Click() 'Cancel
Edit_Exempt.TextBox2.Value = "<Enter>": Edit_Exempt.TextBox3.Value = "<Enter>"
Unload Edit_Exempt
End Sub
Private Sub CommandButton9_Click() 'Set leave
If Selection.Interior.ColorIndex = 15 Then 'Check if leave/exemption cells are not selected.
ExemptType = "leave"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar As Long, secondChar As Long, count As Long
firstChar = InStr(str, "Current")
secondChar = InStr(firstChar, str, "-") + 1
count = secondChar - firstChar
rplc_ref = Mid(str, firstChar, count) 'First date
rplc_ref = Replace(Replace(rplc_ref, "Current " & ExemptType & " period: ", ""), "-", "")
Dim firstChar1 As Long, secondChar1 As Long, count1 As Long
firstChar1 = InStr(str, "Current")
secondChar1 = InStr(firstChar1, str, "-") + 1
count1 = secondChar1 - firstChar1
rplc_ref1 = Mid(str, secondChar1, count1) 'Second date
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "<Enter>" Then 'Check if it's not date
MsgBox "Enter a date in the start date box and a date in the end date box.", vbExclamation, "Personnel Tracker"
TextBox2.SetFocus: Exit Sub
ElseIf Not IsDate(Edit_Exempt.TextBox2.Value) Or Not IsDate(Edit_Exempt.TextBox3.Value) _
Or Edit_Exempt.TextBox2.Value = "" Or Edit_Exempt.TextBox3.Value = "" Then 'Check if it's not date
MsgBox "You must enter a valid date in the start date box and in the end date box. (I.e. M/D/YYYY)", vbExclamation, "Personnel Tracker"
TextBox2.SetFocus: Exit Sub
ElseIf Edit_Exempt.TextBox2.Value = rplc_ref And Edit_Exempt.TextBox3.Value = rplc_ref1 Then 'Check if start and end dates are the same as current.
MsgBox "No changes to apply.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub
ElseIf CDate(Edit_Exempt.TextBox2.Value) > CDate(Edit_Exempt.TextBox3.Value) Then 'Check if start date is after end date.
MsgBox "End date must be the same as or after the start date.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub
ElseIf Year(Edit_Exempt.TextBox2.Value) < FirstYear_Val Or Year(Edit_Exempt.TextBox3.Value) < FirstYear_Val Then 'Check if year doesn't exist.
If CDate(Edit_Exempt.TextBox2.Value) < CDate(Edit_Exempt.TextBox3.Value) Then TextBox2.SetFocus Else: TextBox3.SetFocus
Exit Sub
ElseIf Year(Edit_Exempt.TextBox2.Value) > FinalYear_Val Or Year(Edit_Exempt.TextBox3.Value) > FinalYear_Val Then 'Check if year doesn't exist.
If CDate(Edit_Exempt.TextBox2.Value) > CDate(Edit_Exempt.TextBox3.Value) Then TextBox2.SetFocus Else: TextBox3.SetFocus
Exit Sub
ElseIf (Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Or _
Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1) Then 'Check if previous year is inputted.
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker"). _
Range("D2").Value - 1 & "").Cells, Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2) = 0 Then 'Check if person exists in previous year
MsgBox """" & Range("$B$" & Selection.Row).Value & """ does not exist in " & Worksheets( _
"Troop to Task - Tracker").Range("D2").Value - 1 & ". Add person to previous year or set leave dates to be within the active/following year." _
, vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub: End If: End If
'Note: This nested IF must be after both the check of the previous year's existence and if the previous year is inputted.
If (Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Or _
Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1) And _
Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value).Value = "N/A" Then 'Check if person exists in following year
'Note: Due to the previous nested IF, this IF must be split from all previous ELSEIFs into its own beginning of ELSEIFs, so that the _
checks continue independent of the previous nested IF being TRUE or FALSE.
MsgBox """" & Range("$B$" & Selection.Row).Value & """ does not exist in " & Worksheets( _
"Troop to Task - Tracker").Range("D2").Value + 1 & ". Add person to next year or set leave dates to be within the active year." _
, vbExclamation, "Personnel Tracker": TextBox3.SetFocus: Exit Sub
ElseIf Year(Edit_Exempt.TextBox2.Value) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Or _
Year(Edit_Exempt.TextBox3.Value) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Then 'Check if year is past the previous (year before last)
If CDate(Edit_Exempt.TextBox2.Value) < CDate(Edit_Exempt.TextBox3.Value) Then TextBox2.SetFocus Else TextBox3.SetFocus
Exit Sub
ElseIf Year(Edit_Exempt.TextBox2.Value) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Or _
Year(Edit_Exempt.TextBox3.Value) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Then 'Check if year is past the following (year after next)
If CDate(Edit_Exempt.TextBox2.Value) > CDate(Edit_Exempt.TextBox3.Value) Then TextBox2.SetFocus Else TextBox3.SetFocus
Exit Sub
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 > _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
If CDate(Edit_Exempt.TextBox3.Value) > CDate(Edit_Exempt.TextBox2.Value) Then Edit_Exempt.TextBox3.SetFocus Else Edit_Exempt.TextBox2.SetFocus
Exit Sub
End If
'Set start range:
New_Start_Date = ""
Start_Date_IsPrev = ""
Start_Date_IsNext = ""
Dim cell_MonthGoto As Range, cell_MonthGoto1 As Range
If Month(Edit_Exempt.TextBox2.Value) = "1" Then 'Jan
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "January" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C4").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "2" Then 'Feb
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "February" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C5").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "3" Then 'Mar
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "March" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C6").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "4" Then 'Apr
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "April" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C7").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "5" Then 'May
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "May" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C8").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "6" Then 'Jun
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "June" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C9").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "7" Then 'July
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "July" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C10").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "8" Then 'Aug
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "August" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C11").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "9" Then 'Sep
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "September" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C12").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "10" Then 'Oct
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "October" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C13").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "11" Then 'Nov
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "November" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C14").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "12" Then 'Dec
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "December" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C15").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
Else
MsgBox "Error with date input.", vbCritical, "Error - Personnel Tracker": Edit_Exempt.Show: Exit Sub
End If
Call CommandButton9_Click_Continued
End Sub
Sub CommandButton9_Click_Continued()
'Set end range:
New_End_Date = ""
End_Date_IsPrev = ""
End_Date_IsNext = ""
Dim cell_MonthGoto2 As Range, cell_MonthGoto3 As Range
If Month(Edit_Exempt.TextBox3.Value) = "1" Then 'Jan
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "January" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C4").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "2" Then 'Feb
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "February" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C5").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "3" Then 'Mar
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "March" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C6").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "4" Then 'Apr
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "April" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C7").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "5" Then 'May
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "May" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C8").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "6" Then 'Jun
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "June" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C9").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "7" Then 'July
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "July" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C10").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "8" Then 'Aug
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "August" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C11").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "9" Then 'Sep
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "September" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C12").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "10" Then 'Oct
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "October" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C13").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "11" Then 'Nov
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "November" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C14").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "12" Then 'Dec
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "December" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C15").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
Else
MsgBox "Error with date input.", vbCritical, "Error - Personnel Tracker": Exit Sub
End If
Call CommandButton9_Click_Continued1
End Sub
Sub CommandButton9_Click_Continued1()
Dim answer As Integer
Dim cell_RmvDuty As Range, cell_RmvExempt As Range, cell_IsDutyExemption As Range
answer = MsgBox("Are you sure you want to change the selected leave period for """ & Range("$B$" & Selection.Row).Value & """?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
'Note: The following "Chart 1" and "Chart 2" explains the complete structure of what the code below is checking.
'
'
'
'
'
'Chart 1)
'
' NOTE FOR FOLLOWING CODE - SEQUENTIAL SCENARIO CHECKING METHOD:
'#################################################################################
'# Previous Year: Active Year: Next Year: | NOTES: #
'# _|_________________|_______________|____________| #
'# Scenario 1:_|_____<----->_____|_______________|____________| (Code in ElseIf) #
'# Scenario 2:_|______________<--|-->____________|____________| #
'# Scenario 3:_|_________________|____<----->____|____________| #
'# Scenario 4:_|_________________|____________<--|-->_________| #
'# Scenario 5:_|_________________|_______________|___<----->__| (Code in ElseIf) #
'# Scenario 6:_|______________<--|---------------|-->_________| (Unlikely, N/A) #
'# | #
'# NOTE: Start Date = "<", End Date = ">" | #
'#################################################################################
'
'
'
'
'
'Chart 2)
'
' NOTE FOR FOLLOWING CODE - NON-SEQUENTIAL SCENARIO CHECKING METHOD:
'##################################################################################
'# Previous Year: Active Year: Next Year: | NOTES: #
'# _|_________________|_______________|____________| #
'# Scenario 7:_|______________>--|--<____________|____________| (Impossible, N/A) #
'# Scenario 8:_|_________________|____________>--|--<_________| (Impossible, N/A) #
'# Scenario 9:_|______________>--|---------------|--<_________| (Impossible, N/A) #
'# | #
'# NOTE: Start Date = "<", End Date = ">" | #
'##################################################################################
'
'
'
'
'
If Start_Date_IsPrev = "Yes" Then '<<<STARTS IN PREVIOUS YEAR<<<
If End_Date_IsPrev = "Yes" Then '(<<<STARTS IN PREVIOUS YEAR<<<)>>>ENDS IN PREVIOUS YEAR>>>
'Check if exemption is within dates:
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & New_End_Date)
If cell_IsDutyExemption.Value = "E" Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on duty exemption within the set leave day(s). Override the duty exemption day(s) that the set leave day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates:
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & New_End_Date), "S") <> 0 Or _
Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & New_End_Date), "C") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set leave day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating leave ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 15
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 15
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "L"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "L"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
'Set Dates (previous year):
For Each cell_RmvDuty In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & New_End_Date)
If cell_RmvDuty.Formula2 = "S" Or cell_RmvDuty.Formula2 = "C" Then
If cell_RmvDuty.Offset(-1, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, -1).Formula2 _
= "CQ" Or Left(cell_RmvDuty.Offset(-1, -1).Address, 2) = "$D" Then cell_RmvDuty.Offset(-1, 0).Formula2 = 1 _
Else cell_RmvDuty.Offset(-1, 0).Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(-1, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(-1, 1).Formula2 = "=R[0]C[-1]" & "+1"
End If: cell_RmvDuty.Value = "L"
Next cell_RmvDuty
'Clear Dates (active year):
With Range(StartDate_Clear, EndDate_Clear).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With Range(StartDate_Clear, EndDate_Clear)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(StartDate_Clear, EndDate_Clear).NumberFormat = "General"
For Each cell_RmvExempt In Range(StartDate_Clear, EndDate_Clear)
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell_RmvExempt
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.UpdateRemoteReferences = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
PleaseWait.Label2.Caption = ""
Unload PleaseWait
Application.Run "Sheet1.Worksheet_SelectionChange", Selection
Unload Edit_Exempt: Exit Sub
ElseIf End_Date_IsNext = "Yes" Then '(<<<STARTS IN PREVIOUS YEAR<<<)>>>ENDS IN NEXT YEAR>>>
'Note: This is extremely unlikely, and if true, is very easy for the user to work around, thus unnecessary/redundant to program.
MsgBox "With a start date prior to the active year, the end date cannot protrude beyond the active year (into the follwing year).", _
vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub 'Scenario N/A
Else '(<<<STARTS IN PREVIOUS YEAR<<<)>>>ENDS IN ACTIVE YEAR>>>
RngCount_ActiveYear = DateDiff("d", Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value) + 1
RngCount_NonActiveYear = Range(New_Start_Date & ":" & Range("E" & Range(New_Start_Date).Row).Offset(0, ThisWorkbook.Sheets("" & Worksheets( _
"Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("B1").Value - 1).Address).Cells.count
RngCount_ActiveYear = RngCount_ActiveYear - RngCount_NonActiveYear '(Note: This variable's use is obsolete in this Tracker version.)
'Check if exemption is within dates (previous and active year):
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & Range(New_Start_Date).Offset(0, RngCount_NonActiveYear - 1).Address)
If cell_IsDutyExemption.Value = "E" Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
For Each cell_IsDutyExemption In Worksheets("Troop to Task - Tracker").Range(Worksheets("Troop to Task - Tracker").Range("E" & _
Selection.Row).Address & ":" & New_End_Date)
If cell_IsDutyExemption.Interior.ColorIndex = 37 Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on duty exemption within the set leave day(s). Override the duty exemption day(s) that the set leave day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates (previous and active year):
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & Range(New_Start_Date).Offset(0, RngCount_NonActiveYear - 1).Address), "S") <> 0 Or _
Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & Range(New_Start_Date).Offset(0, RngCount_NonActiveYear - 1).Address), "C") <> 0 Or _
Application.WorksheetFunction.CountIf(Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":" & New_End_Date), "Staff") _
<> 0 Or Application.WorksheetFunction.CountIf(Worksheets("Troop to Task - Tracker").Range("E" & _
Selection.Row & ":" & New_End_Date), "CQ") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set leave day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating leave ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 15
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 15
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "L"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "L"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
'Set Dates (previous year):
For Each cell_RmvDuty In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & Range(New_Start_Date).Offset(0, RngCount_NonActiveYear - 1).Address)
If cell_RmvDuty.Formula2 = "S" Or cell_RmvDuty.Formula2 = "C" Then
If cell_RmvDuty.Offset(-1, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, -1).Formula2 _
= "CQ" Or Left(cell_RmvDuty.Offset(-1, -1).Address, 2) = "$D" Then cell_RmvDuty.Offset(-1, 0).Formula2 = 1 _
Else cell_RmvDuty.Offset(-1, 0).Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(-1, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(-1, 1).Formula2 = "=R[0]C[-1]" & "+1"
End If: cell_RmvDuty.Value = "L"
Next cell_RmvDuty
'ActiveYear_Start_Date = Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":" & Range("E" & Selection.Row).Offset(0, RngCount_ActiveYear - 1).Address).Address
ActiveYear_Start_Date = Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row).Address
ActiveYear_End_Date = New_End_Date
End If
ElseIf Start_Date_IsNext = "Yes" Then '<<<STARTS IN NEXT YEAR<<<
If End_Date_IsNext = "Yes" Then '(<<<STARTS IN NEXT YEAR<<<)>>>ENDS IN NEXT YEAR>>>
'Check if exemption is within dates:
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
New_Start_Date & ":" & New_End_Date)
If cell_IsDutyExemption.Value = "E" Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on duty exemption within the set leave day(s). Override the duty exemption day(s) that the set leave day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates:
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
New_Start_Date & ":" & New_End_Date), "S") <> 0 Or _
Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
New_Start_Date & ":" & New_End_Date), "C") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set leave day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating leave ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 15
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 15
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "L"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "L"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
'Set Dates (next year):
For Each cell_RmvDuty In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
New_Start_Date & ":" & New_End_Date)
If cell_RmvDuty.Formula2 = "S" Or cell_RmvDuty.Formula2 = "C" Then
If cell_RmvDuty.Offset(-1, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, -1).Formula2 _
= "CQ" Or Left(cell_RmvDuty.Offset(-1, -1).Address, 2) = "$D" Then cell_RmvDuty.Offset(-1, 0).Formula2 = 1 _
Else cell_RmvDuty.Offset(-1, 0).Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(-1, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(-1, 1).Formula2 = "=R[0]C[-1]" & "+1"
End If: cell_RmvDuty.Value = "L"
Next cell_RmvDuty
'Clear Dates (active year):
With Range(StartDate_Clear, EndDate_Clear).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With Range(StartDate_Clear, EndDate_Clear)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(StartDate_Clear, EndDate_Clear).NumberFormat = "General"
For Each cell_RmvExempt In Range(StartDate_Clear, EndDate_Clear)
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell_RmvExempt
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.UpdateRemoteReferences = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
PleaseWait.Label2.Caption = ""
Unload PleaseWait
Application.Run "Sheet1.Worksheet_SelectionChange", Selection
Unload Edit_Exempt: Exit Sub
ElseIf End_Date_IsPrev = "Yes" Then '(<<<STARTS IN NEXT YEAR<<<)>>>ENDS IN PREVIOUS YEAR>>>
MsgBox "End date must be the same as or after the start date.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub 'Scenario N/A
Else '(<<<STARTS IN NEXT YEAR<<<)>>>ENDS IN ACTIVE YEAR>>>
MsgBox "End date must be the same as or after the start date.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub 'Scenario N/A
End If
Else '<<<STARTS IN ACTIVE YEAR<<<
If End_Date_IsPrev = "Yes" Then '(<<<STARTS IN ACTIVE YEAR<<<)>>>ENDS IN PREVIOUS YEAR>>>
MsgBox "End date must be the same as or after the start date.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub 'Scenario N/A
ElseIf End_Date_IsNext = "Yes" Then '(<<<STARTS IN ACTIVE YEAR<<<)>>>ENDS IN NEXT YEAR>>>
Rng_NonActiveYear = Range("E" & Range(New_End_Date).Row & ":" & New_End_Date).Address
Rng_ActiveYear = Range(New_Start_Date & ":" & Range("E" & Range(New_Start_Date).Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value - 1).Address).Address
'Check if exemption is within dates (previous and active year):
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
Rng_NonActiveYear)
If cell_IsDutyExemption.Value = "E" Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
For Each cell_IsDutyExemption In Worksheets("Troop to Task - Tracker").Range(Rng_ActiveYear)
If cell_IsDutyExemption.Interior.ColorIndex = 37 Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on duty exemption within the set leave day(s). Override the duty exemption day(s) that the set leave day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates (previous and active year):
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
Rng_NonActiveYear), "S") <> 0 Or _
Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
Rng_NonActiveYear), "C") <> 0 Or _
Application.WorksheetFunction.CountIf(Worksheets("Troop to Task - Tracker").Range(Rng_ActiveYear), "Staff") <> 0 Or _
Application.WorksheetFunction.CountIf(Worksheets("Troop to Task - Tracker").Range(Rng_ActiveYear), "CQ") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set leave day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating leave ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 15
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 15
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "L"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "L"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
'Set Dates (next year):
For Each cell_RmvDuty In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
Rng_NonActiveYear)
If cell_RmvDuty.Formula2 = "S" Or cell_RmvDuty.Formula2 = "C" Then
If cell_RmvDuty.Offset(-1, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, -1).Formula2 _
= "CQ" Or Left(cell_RmvDuty.Offset(-1, -1).Address, 2) = "$D" Then cell_RmvDuty.Offset(-1, 0).Formula2 = 1 _
Else cell_RmvDuty.Offset(-1, 0).Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(-1, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(-1, 1).Formula2 = "=R[0]C[-1]" & "+1"
End If: cell_RmvDuty.Value = "L"
Next cell_RmvDuty
ActiveYear_Start_Date = New_Start_Date
ActiveYear_End_Date = Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value - 1).Address
Else '(<<<STARTS IN ACTIVE YEAR<<<)>>>ENDS IN ACTIVE YEAR>>>
'Check if exemption is within dates:
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In Worksheets("Troop to Task - Tracker").Range(New_Start_Date & ":" & New_End_Date)
If cell_IsDutyExemption.Interior.ColorIndex = 37 Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on duty exemption within the set leave day(s). Override the duty exemption day(s) that the set leave day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates:
If Application.WorksheetFunction.CountIf(Range(New_Start_Date & ":" & New_End_Date), "Staff") <> 0 Or _
Application.WorksheetFunction.CountIf(Range(New_Start_Date & ":" & New_End_Date), "CQ") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set leave day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating leave ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 15
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 15
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "L"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "L" Then 'Check if leave continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "L"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
ActiveYear_Start_Date = New_Start_Date
ActiveYear_End_Date = New_End_Date
End If
End If
'Clear dates (Active year):
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 15
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 15
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
With Range(StartDate_Clear, EndDate_Clear).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With Range(StartDate_Clear, EndDate_Clear)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(StartDate_Clear, EndDate_Clear).NumberFormat = "General"
For Each cell_RmvExempt In Range(StartDate_Clear, EndDate_Clear)
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell_RmvExempt
'Set Dates (active year):
For Each cell_RmvDuty In Worksheets("Troop to Task - Tracker").Range(ActiveYear_Start_Date & ":" & ActiveYear_End_Date)
If cell_RmvDuty.Formula2 = "Staff" Or cell_RmvDuty.Formula2 = "CQ" Then
If cell_RmvDuty.Offset(0, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(0, -1).Formula2 _
= "CQ" Then cell_RmvDuty.Formula2 = 1 Else cell_RmvDuty.Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(0, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(0, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(0, 1).Formula2 = "=R[0]C[-1]" & "+1"
With cell_RmvDuty.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With cell_RmvDuty
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
cell_RmvDuty.NumberFormat = "General"
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvDuty.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvDuty.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvDuty.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvDuty.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
Next cell_RmvDuty
With Range(ActiveYear_Start_Date & ":" & ActiveYear_End_Date).Interior 'Set leave color
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.UpdateRemoteReferences = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
PleaseWait.Label2.Caption = ""
Unload PleaseWait
Application.Run "Sheet1.Worksheet_SelectionChange", Selection
Unload Edit_Exempt
End Sub
Private Sub CommandButton10_Click() 'Set exemption
If Selection.Interior.ColorIndex = 37 Then 'Check if leave/exemption cells are not selected.
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar As Long, secondChar As Long, count As Long
firstChar = InStr(str, "Current")
secondChar = InStr(firstChar, str, "-") + 1
count = secondChar - firstChar
rplc_ref = Mid(str, firstChar, count) 'First date
rplc_ref = Replace(Replace(rplc_ref, "Current " & ExemptType & " period: ", ""), "-", "")
Dim firstChar1 As Long, secondChar1 As Long, count1 As Long
firstChar1 = InStr(str, "Current")
secondChar1 = InStr(firstChar1, str, "-") + 1
count1 = secondChar1 - firstChar1
rplc_ref1 = Mid(str, secondChar1, count1) 'Second date
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "<Enter>" Then 'Check if it's not date
MsgBox "Enter a date in the start date box and a date in the end date box.", vbExclamation, "Personnel Tracker"
TextBox2.SetFocus: Exit Sub
ElseIf Not IsDate(Edit_Exempt.TextBox2.Value) Or Not IsDate(Edit_Exempt.TextBox3.Value) _
Or Edit_Exempt.TextBox2.Value = "" Or Edit_Exempt.TextBox3.Value = "" Then 'Check if it's not date
MsgBox "You must enter a valid date in the start date box and in the end date box. (I.e. M/D/YYYY)", vbExclamation, "Personnel Tracker"
TextBox2.SetFocus: Exit Sub
ElseIf Edit_Exempt.TextBox2.Value = rplc_ref And Edit_Exempt.TextBox3.Value = rplc_ref1 Then 'Check if start and end dates are the same as current.
MsgBox "No changes to apply.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub
ElseIf CDate(Edit_Exempt.TextBox2.Value) > CDate(Edit_Exempt.TextBox3.Value) Then 'Check if start date is after end date.
MsgBox "End date must be the same as or after the start date.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub
ElseIf Year(Edit_Exempt.TextBox2.Value) < FirstYear_Val Or Year(Edit_Exempt.TextBox3.Value) < FirstYear_Val Then 'Check if year doesn't exist.
If CDate(Edit_Exempt.TextBox2.Value) < CDate(Edit_Exempt.TextBox3.Value) Then TextBox2.SetFocus Else: TextBox3.SetFocus
Exit Sub
ElseIf Year(Edit_Exempt.TextBox2.Value) > FinalYear_Val Or Year(Edit_Exempt.TextBox3.Value) > FinalYear_Val Then 'Check if year doesn't exist.
If CDate(Edit_Exempt.TextBox2.Value) > CDate(Edit_Exempt.TextBox3.Value) Then TextBox2.SetFocus Else: TextBox3.SetFocus
Exit Sub
ElseIf (Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Or _
Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1) Then 'Check if previous year is inputted.
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker"). _
Range("D2").Value - 1 & "").Cells, Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2) = 0 Then 'Check if person exists in previous year
MsgBox """" & Range("$B$" & Selection.Row).Value & """ does not exist in " & Worksheets( _
"Troop to Task - Tracker").Range("D2").Value - 1 & ". Add person to previous year or set duty exemption dates to be within the active/following year." _
, vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub: End If: End If
'Note: This nested IF must be after both the check of the previous year's existence and if the previous year is inputted.
If (Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Or _
Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1) And _
Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value).Value = "N/A" Then 'Check if person exists in following year
'Note: Due to the previous nested IF, this IF must be split from all previous ELSEIFs into its own beginning of ELSEIFs, so that the _
checks continue independent of the previous nested IF being TRUE or FALSE.
MsgBox """" & Range("$B$" & Selection.Row).Value & """ does not exist in " & Worksheets( _
"Troop to Task - Tracker").Range("D2").Value + 1 & ". Add person to next year or set duty exemption dates to be within the active year." _
, vbExclamation, "Personnel Tracker": TextBox3.SetFocus: Exit Sub
ElseIf Year(Edit_Exempt.TextBox2.Value) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Or _
Year(Edit_Exempt.TextBox3.Value) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Then 'Check if year is past the previous (year before last)
If CDate(Edit_Exempt.TextBox2.Value) < CDate(Edit_Exempt.TextBox3.Value) Then TextBox2.SetFocus Else TextBox3.SetFocus
Exit Sub
ElseIf Year(Edit_Exempt.TextBox2.Value) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Or _
Year(Edit_Exempt.TextBox3.Value) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Then 'Check if year is past the following (year after next)
If CDate(Edit_Exempt.TextBox2.Value) > CDate(Edit_Exempt.TextBox3.Value) Then TextBox2.SetFocus Else TextBox3.SetFocus
Exit Sub
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 > _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
If CDate(Edit_Exempt.TextBox3.Value) > CDate(Edit_Exempt.TextBox2.Value) Then Edit_Exempt.TextBox3.SetFocus Else Edit_Exempt.TextBox2.SetFocus
Exit Sub
End If
'Set start range:
New_Start_Date = ""
Start_Date_IsPrev = ""
Start_Date_IsNext = ""
Dim cell_MonthGoto As Range, cell_MonthGoto1 As Range
If Month(Edit_Exempt.TextBox2.Value) = "1" Then 'Jan
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "January" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C4").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "2" Then 'Feb
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "February" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C5").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "3" Then 'Mar
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "March" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C6").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "4" Then 'Apr
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "April" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C7").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "5" Then 'May
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "May" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C8").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "6" Then 'Jun
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "June" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C9").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "7" Then 'July
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "July" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C10").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "8" Then 'Aug
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "August" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C11").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "9" Then 'Sep
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "September" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C12").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "10" Then 'Oct
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "October" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C13").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "11" Then 'Nov
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "November" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C14").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox2.Value) = "12" Then 'Dec
If Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox2.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_Start_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Prev).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox2.Value, "1/1/" & Year(Edit_Exempt.TextBox2.Value))).Address: Start_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "December" Then Exit For
Next cell_MonthGoto
For Each cell_MonthGoto1 In Range(cell_MonthGoto.Address, cell_MonthGoto.Offset(0, Worksheets("Formula & Code Data").Range("C15").Value).Address)
If cell_MonthGoto1.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox2.Value) Then Exit For
Next cell_MonthGoto1
New_Start_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto1.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
Else
MsgBox "Error with date input.", vbCritical, "Error - Personnel Tracker": Edit_Exempt.Show: Exit Sub
End If
Call CommandButton10_Click_Continued
End Sub
Sub CommandButton10_Click_Continued()
'Set end range:
New_End_Date = ""
End_Date_IsPrev = ""
End_Date_IsNext = ""
Dim cell_MonthGoto2 As Range, cell_MonthGoto3 As Range
If Month(Edit_Exempt.TextBox3.Value) = "1" Then 'Jan
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "January" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C4").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "2" Then 'Feb
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "February" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C5").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "3" Then 'Mar
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "March" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C6").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "4" Then 'Apr
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "April" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C7").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "5" Then 'May
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "May" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C8").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "6" Then 'Jun
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "June" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C9").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "7" Then 'July
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "July" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C10").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "8" Then 'Aug
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "August" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C11").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "9" Then 'Sep
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "September" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C12").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "10" Then 'Oct
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "October" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C13").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "11" Then 'Nov
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "November" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C14").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
ElseIf Month(Edit_Exempt.TextBox3.Value) = "12" Then 'Dec
If Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsPrev = "Yes"
ElseIf Year(Edit_Exempt.TextBox3.Value) = Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 Then
RowFind_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Row
New_End_Date = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("E" & RowFind_Next).Offset(0, _
-DateDiff("d", Edit_Exempt.TextBox3.Value, "1/1/" & Year(Edit_Exempt.TextBox3.Value))).Address: End_Date_IsNext = "Yes"
Else
On Error Resume Next
For Each cell_MonthGoto2 In Range("E8", Range("E8").Offset(0, Worksheets("Formula & Code Data").Range("C16").Value))
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto2.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value = "December" Then Exit For
Next cell_MonthGoto2
For Each cell_MonthGoto3 In Range(cell_MonthGoto2.Address, cell_MonthGoto2.Offset(0, Worksheets("Formula & Code Data").Range("C15").Value).Address)
If cell_MonthGoto3.Offset(-1, 0).Value = Day(Edit_Exempt.TextBox3.Value) Then Exit For
Next cell_MonthGoto3
New_End_Date = Range(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_MonthGoto3.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", "") & Selection.Row).Address
End If
Else
MsgBox "Error with date input.", vbCritical, "Error - Personnel Tracker": Exit Sub
End If
Call CommandButton10_Click_Continued1
End Sub
Sub CommandButton10_Click_Continued1()
Dim answer As Integer
Dim cell_RmvDuty As Range, cell_RmvExempt As Range, cell_IsDutyExemption As Range
answer = MsgBox("Are you sure you want to change the selected duty exemption period for """ & Range("$B$" & Selection.Row).Value & """?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
'Note: The following "Chart 1" and "Chart 2" explains the complete structure of what the code below is checking.
'
'
'
'
'
'Chart 1)
'
' NOTE FOR FOLLOWING CODE - SEQUENTIAL SCENARIO CHECKING METHOD:
'#################################################################################
'# Previous Year: Active Year: Next Year: | NOTES: #
'# _|_________________|_______________|____________| #
'# Scenario 1:_|_____<----->_____|_______________|____________| (Code in ElseIf) #
'# Scenario 2:_|______________<--|-->____________|____________| #
'# Scenario 3:_|_________________|____<----->____|____________| #
'# Scenario 4:_|_________________|____________<--|-->_________| #
'# Scenario 5:_|_________________|_______________|___<----->__| (Code in ElseIf) #
'# Scenario 6:_|______________<--|---------------|-->_________| (Unlikely, N/A) #
'# | #
'# NOTE: Start Date = "<", End Date = ">" | #
'#################################################################################
'
'
'
'
'
'Chart 2)
'
' NOTE FOR FOLLOWING CODE - NON-SEQUENTIAL SCENARIO CHECKING METHOD:
'##################################################################################
'# Previous Year: Active Year: Next Year: | NOTES: #
'# _|_________________|_______________|____________| #
'# Scenario 7:_|______________>--|--<____________|____________| (Impossible, N/A) #
'# Scenario 8:_|_________________|____________>--|--<_________| (Impossible, N/A) #
'# Scenario 9:_|______________>--|---------------|--<_________| (Impossible, N/A) #
'# | #
'# NOTE: Start Date = "<", End Date = ">" | #
'##################################################################################
'
'
'
'
'
If Start_Date_IsPrev = "Yes" Then '<<<STARTS IN PREVIOUS YEAR<<<
If End_Date_IsPrev = "Yes" Then '(<<<STARTS IN PREVIOUS YEAR<<<)>>>ENDS IN PREVIOUS YEAR>>>
'Check if exemption is within dates:
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & New_End_Date)
If cell_IsDutyExemption.Value = "L" Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on leave within the set duty exemption day(s). Override the leave day(s) that the set duty exemption day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates:
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & New_End_Date), "S") <> 0 Or _
Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & New_End_Date), "C") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set duty exemption day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating exemption ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 37
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 37
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "E"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "E"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
'Set Dates (previous year):
For Each cell_RmvDuty In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & New_End_Date)
If cell_RmvDuty.Formula2 = "S" Or cell_RmvDuty.Formula2 = "C" Then
If cell_RmvDuty.Offset(-1, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, -1).Formula2 _
= "CQ" Or Left(cell_RmvDuty.Offset(-1, -1).Address, 2) = "$D" Then cell_RmvDuty.Offset(-1, 0).Formula2 = 1 _
Else cell_RmvDuty.Offset(-1, 0).Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(-1, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(-1, 1).Formula2 = "=R[0]C[-1]" & "+1"
End If: cell_RmvDuty.Value = "E"
Next cell_RmvDuty
'Clear Dates (active year):
With Range(StartDate_Clear, EndDate_Clear).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With Range(StartDate_Clear, EndDate_Clear)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(StartDate_Clear, EndDate_Clear).NumberFormat = "General"
For Each cell_RmvExempt In Range(StartDate_Clear, EndDate_Clear)
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell_RmvExempt
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.UpdateRemoteReferences = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
PleaseWait.Label2.Caption = ""
Unload PleaseWait
Application.Run "Sheet1.Worksheet_SelectionChange", Selection
Unload Edit_Exempt: Exit Sub
ElseIf End_Date_IsNext = "Yes" Then '(<<<STARTS IN PREVIOUS YEAR<<<)>>>ENDS IN NEXT YEAR>>>
'Note: This is extremely unlikely, and if true, is very easy for the user to work around, thus unnecessary/redundant to program.
MsgBox "With a start date prior to the active year, the end date cannot protrude beyond the active year (into the follwing year).", _
vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub 'Scenario N/A
Else '(<<<STARTS IN PREVIOUS YEAR<<<)>>>ENDS IN ACTIVE YEAR>>>
RngCount_ActiveYear = DateDiff("d", Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value) + 1
RngCount_NonActiveYear = Range(New_Start_Date & ":" & Range("E" & Range(New_Start_Date).Row).Offset(0, ThisWorkbook.Sheets("" & Worksheets( _
"Troop to Task - Tracker").Range("D2").Value - 1 & "").Range("B1").Value - 1).Address).Cells.count
RngCount_ActiveYear = RngCount_ActiveYear - RngCount_NonActiveYear '(Note: This variable's use is obsolete in this Tracker version.)
'Check if exemption is within dates (previous and active year):
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & Range(New_Start_Date).Offset(0, RngCount_NonActiveYear - 1).Address)
If cell_IsDutyExemption.Value = "L" Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
For Each cell_IsDutyExemption In Worksheets("Troop to Task - Tracker").Range(Worksheets("Troop to Task - Tracker").Range("E" & _
Selection.Row).Address & ":" & New_End_Date)
If cell_IsDutyExemption.Interior.ColorIndex = 15 Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on leave within the set duty exemption day(s). Override the leave day(s) that the set duty exemption day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates (previous and active year):
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & Range(New_Start_Date).Offset(0, RngCount_NonActiveYear - 1).Address), "S") <> 0 Or _
Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & Range(New_Start_Date).Offset(0, RngCount_NonActiveYear - 1).Address), "C") <> 0 Or _
Application.WorksheetFunction.CountIf(Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":" & New_End_Date), "Staff") _
<> 0 Or Application.WorksheetFunction.CountIf(Worksheets("Troop to Task - Tracker").Range("E" & _
Selection.Row & ":" & New_End_Date), "CQ") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set duty exemption day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating exemption ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 37
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 37
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "E"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "E"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
'Set Dates (previous year):
For Each cell_RmvDuty In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
New_Start_Date & ":" & Range(New_Start_Date).Offset(0, RngCount_NonActiveYear - 1).Address)
If cell_RmvDuty.Formula2 = "S" Or cell_RmvDuty.Formula2 = "C" Then
If cell_RmvDuty.Offset(-1, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, -1).Formula2 _
= "CQ" Or Left(cell_RmvDuty.Offset(-1, -1).Address, 2) = "$D" Then cell_RmvDuty.Offset(-1, 0).Formula2 = 1 _
Else cell_RmvDuty.Offset(-1, 0).Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(-1, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(-1, 1).Formula2 = "=R[0]C[-1]" & "+1"
End If: cell_RmvDuty.Value = "E"
Next cell_RmvDuty
'ActiveYear_Start_Date = Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":" & Range("E" & Selection.Row).Offset(0, RngCount_ActiveYear - 1).Address).Address
ActiveYear_Start_Date = Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row).Address
ActiveYear_End_Date = New_End_Date
End If
ElseIf Start_Date_IsNext = "Yes" Then '<<<STARTS IN NEXT YEAR<<<
If End_Date_IsNext = "Yes" Then '(<<<STARTS IN NEXT YEAR<<<)>>>ENDS IN NEXT YEAR>>>
'Check if exemption is within dates:
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
New_Start_Date & ":" & New_End_Date)
If cell_IsDutyExemption.Value = "L" Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on leave within the set duty exemption day(s). Override the leave day(s) that the set duty exemption day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates:
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
New_Start_Date & ":" & New_End_Date), "S") <> 0 Or _
Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
New_Start_Date & ":" & New_End_Date), "C") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set duty exemption day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating exemption ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 37
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 37
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "E"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "E"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
'Set Dates (next year):
For Each cell_RmvDuty In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
New_Start_Date & ":" & New_End_Date)
If cell_RmvDuty.Formula2 = "S" Or cell_RmvDuty.Formula2 = "C" Then
If cell_RmvDuty.Offset(-1, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, -1).Formula2 _
= "CQ" Or Left(cell_RmvDuty.Offset(-1, -1).Address, 2) = "$D" Then cell_RmvDuty.Offset(-1, 0).Formula2 = 1 _
Else cell_RmvDuty.Offset(-1, 0).Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(-1, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(-1, 1).Formula2 = "=R[0]C[-1]" & "+1"
End If: cell_RmvDuty.Value = "E"
Next cell_RmvDuty
'Clear Dates (active year):
With Range(StartDate_Clear, EndDate_Clear).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With Range(StartDate_Clear, EndDate_Clear)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(StartDate_Clear, EndDate_Clear).NumberFormat = "General"
For Each cell_RmvExempt In Range(StartDate_Clear, EndDate_Clear)
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell_RmvExempt
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.UpdateRemoteReferences = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
PleaseWait.Label2.Caption = ""
Unload PleaseWait
Application.Run "Sheet1.Worksheet_SelectionChange", Selection
Unload Edit_Exempt: Exit Sub
ElseIf End_Date_IsPrev = "Yes" Then '(<<<STARTS IN NEXT YEAR<<<)>>>ENDS IN PREVIOUS YEAR>>>
MsgBox "End date must be the same as or after the start date.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub 'Scenario N/A
Else '(<<<STARTS IN NEXT YEAR<<<)>>>ENDS IN ACTIVE YEAR>>>
MsgBox "End date must be the same as or after the start date.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub 'Scenario N/A
End If
Else '<<<STARTS IN ACTIVE YEAR<<<
If End_Date_IsPrev = "Yes" Then '(<<<STARTS IN ACTIVE YEAR<<<)>>>ENDS IN PREVIOUS YEAR>>>
MsgBox "End date must be the same as or after the start date.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub 'Scenario N/A
ElseIf End_Date_IsNext = "Yes" Then '(<<<STARTS IN ACTIVE YEAR<<<)>>>ENDS IN NEXT YEAR>>>
Rng_NonActiveYear = Range("E" & Range(New_End_Date).Row & ":" & New_End_Date).Address
Rng_ActiveYear = Range(New_Start_Date & ":" & Range("E" & Range(New_Start_Date).Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value - 1).Address).Address
'Check if exemption is within dates (previous and active year):
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
Rng_NonActiveYear)
If cell_IsDutyExemption.Value = "L" Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
For Each cell_IsDutyExemption In Worksheets("Troop to Task - Tracker").Range(Rng_ActiveYear)
If cell_IsDutyExemption.Interior.ColorIndex = 15 Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on leave within the set duty exemption day(s). Override the leave day(s) that the set duty exemption day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates (previous and active year):
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
Rng_NonActiveYear), "S") <> 0 Or _
Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
Rng_NonActiveYear), "C") <> 0 Or _
Application.WorksheetFunction.CountIf(Worksheets("Troop to Task - Tracker").Range(Rng_ActiveYear), "Staff") <> 0 Or _
Application.WorksheetFunction.CountIf(Worksheets("Troop to Task - Tracker").Range(Rng_ActiveYear), "CQ") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set duty exemption day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating exemption ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 37
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 37
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "E"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "E"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
'Set Dates (next year):
For Each cell_RmvDuty In ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
Rng_NonActiveYear)
If cell_RmvDuty.Formula2 = "S" Or cell_RmvDuty.Formula2 = "C" Then
If cell_RmvDuty.Offset(-1, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, -1).Formula2 _
= "CQ" Or Left(cell_RmvDuty.Offset(-1, -1).Address, 2) = "$D" Then cell_RmvDuty.Offset(-1, 0).Formula2 = 1 _
Else cell_RmvDuty.Offset(-1, 0).Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(-1, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(-1, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(-1, 1).Formula2 = "=R[0]C[-1]" & "+1"
End If: cell_RmvDuty.Value = "E"
Next cell_RmvDuty
ActiveYear_Start_Date = New_Start_Date
ActiveYear_End_Date = Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value - 1).Address
Else '(<<<STARTS IN ACTIVE YEAR<<<)>>>ENDS IN ACTIVE YEAR>>>
'Check if exemption is within dates:
IsDutyExemption_count = 0
For Each cell_IsDutyExemption In Worksheets("Troop to Task - Tracker").Range(New_Start_Date & ":" & New_End_Date)
If cell_IsDutyExemption.Interior.ColorIndex = 15 Then IsDutyExemption_count = IsDutyExemption_count + 1
Next cell_IsDutyExemption
If IsDutyExemption_count > 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is on leave within the set duty exemption day(s). Override the leave day(s) that the set duty exemption day(s) will apply and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
'Check if duty is within dates:
If Application.WorksheetFunction.CountIf(Range(New_Start_Date & ":" & New_End_Date), "Staff") <> 0 Or _
Application.WorksheetFunction.CountIf(Range(New_Start_Date & ":" & New_End_Date), "CQ") <> 0 Then
answer = MsgBox("""" & Range("$B$" & Selection.Row).Value & """ is assigned one or more duties within the set duty exemption day(s). Remove the duty(s) and continue?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
End If
Edit_Exempt.Hide
PleaseWait.Show
PleaseWait.Label2.Caption = "Updating exemption ..."
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 37
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 37
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
'Check then clear previous year:
If Left(Range(StartDate_Clear).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
PrevYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the last day of previous year
StartExemptDate_Prev_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear).Value <> "E"
StartExemptDate_Prev_Clear = StartExemptDate_Prev_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng_Clear, Range(PrevYear_StartRng_Clear).Offset(0, -StartExemptDate_Prev_Clear + 1).Address).ClearContents
End If: End If
'Check then clear following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate_Clear).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
NextYear_StartRng_Clear = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng_Clear).Value = "E" Then 'Check if exemption continues the first day of next year
EndExemptDate_Next_Clear = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear).Value <> "E"
EndExemptDate_Next_Clear = EndExemptDate_Next_Clear + 1
Loop
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng_Clear, Range(NextYear_StartRng_Clear).Offset(0, EndExemptDate_Next_Clear - 1).Address).ClearContents
End If: End If
ActiveYear_Start_Date = New_Start_Date
ActiveYear_End_Date = New_End_Date
End If
End If
'Clear dates (Active year):
StartExemptDate_Clear = 0
Do Until Selection.Offset(0, -StartExemptDate_Clear).Interior.ColorIndex <> 37
StartExemptDate_Clear = StartExemptDate_Clear + 1
Loop
EndExemptDate_Clear = 0
Do Until Selection.Offset(0, EndExemptDate_Clear).Interior.ColorIndex <> 37
EndExemptDate_Clear = EndExemptDate_Clear + 1
Loop
StartDate_Clear = Selection.Offset(0, -StartExemptDate_Clear + 1).Address
EndDate_Clear = Selection.Offset(0, EndExemptDate_Clear - 1).Address
With Range(StartDate_Clear, EndDate_Clear).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With Range(StartDate_Clear, EndDate_Clear)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(StartDate_Clear, EndDate_Clear).NumberFormat = "General"
For Each cell_RmvExempt In Range(StartDate_Clear, EndDate_Clear)
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell_RmvExempt
'Set Dates (active year):
For Each cell_RmvDuty In Worksheets("Troop to Task - Tracker").Range(ActiveYear_Start_Date & ":" & ActiveYear_End_Date)
If cell_RmvDuty.Formula2 = "Staff" Or cell_RmvDuty.Formula2 = "CQ" Then
If cell_RmvDuty.Offset(0, -1).Formula2 = "Staff" Or cell_RmvDuty.Offset(0, -1).Formula2 _
= "CQ" Then cell_RmvDuty.Formula2 = 1 Else cell_RmvDuty.Formula2 = "=R[0]C[-1]" & "+1"
If cell_RmvDuty.Offset(0, 1).Formula2 = "Staff" Or cell_RmvDuty.Offset(0, 1).Formula2 _
= "CQ" Then Else cell_RmvDuty.Offset(0, 1).Formula2 = "=R[0]C[-1]" & "+1"
With cell_RmvDuty.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With cell_RmvDuty
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
cell_RmvDuty.NumberFormat = "General"
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvDuty.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvDuty.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvDuty.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvDuty.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
Next cell_RmvDuty
With Range(ActiveYear_Start_Date & ":" & ActiveYear_End_Date).Interior 'Set exemption color
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.UpdateRemoteReferences = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
PleaseWait.Label2.Caption = ""
Unload PleaseWait
Application.Run "Sheet1.Worksheet_SelectionChange", Selection
Unload Edit_Exempt
End Sub
Private Sub CommandButton2_Click() 'Remove leave
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim answer As Integer
answer = MsgBox("Are you sure you want to remove the selected leave period for """ & Range("$B$" & Selection.Row).Value & """?", vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
Unload Edit_Exempt
'Note: No values required from the dialog box for leave removal, thus can be safely unloaded.
PleaseWait.Show
PleaseWait.Label2.Caption = "Removing leave ..."
DoEvents
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
'Check active year:
If Selection.Interior.ColorIndex = 15 Then
StartExemptDate = 0
Do Until Selection.Offset(0, -StartExemptDate).Interior.ColorIndex <> 15
StartExemptDate = StartExemptDate + 1
Loop
EndExemptDate = 0
Do Until Selection.Offset(0, EndExemptDate).Interior.ColorIndex <> 15
EndExemptDate = EndExemptDate + 1
Loop
Else: Exit Sub: End If
StartDate = Selection.Offset(0, -StartExemptDate + 1).Address
EndDate = Selection.Offset(0, EndExemptDate - 1).Address
'Check and set previous year:
If Left(Range(StartDate).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
If Not Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 < FirstYear_Val Then 'Check if greater than or equal to first generated year
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker"). _
Range("D2").Value - 1 & "").Cells, Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2) > 0 Then 'Check if person exists MAYBE USE THIS IF INSTEAD OF FIND???!!!
PrevYear_StartRng = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng).Value = "L" Then 'Check if leave continues the first day of previous year
StartExemptDate_Prev = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng).Offset(0, -StartExemptDate_Prev).Value <> "L"
StartExemptDate_Prev = StartExemptDate_Prev + 1
Loop
EndExemptDate_Prev = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng).Offset(0, EndExemptDate_Prev).Value <> "L"
EndExemptDate_Prev = EndExemptDate_Prev + 1
Loop
StartDate_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Range(PrevYear_StartRng).Offset(0, -StartExemptDate_Prev + 1).Address
EndDate_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range _
(PrevYear_StartRng).Offset(0, EndExemptDate_Prev - 1).Address
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range(StartDate_Prev, _
EndDate_Prev).ClearContents: End If: End If: End If: End If
'Check and set following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
If Not Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 > FinalYear_Val Then 'Check if less than or equal to last generated year
If Not Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value).Value = "N/A" Then 'Check if person exists
NextYear_StartRng = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng).Value = "L" Then 'Check if leave continues the first day of next year
StartExemptDate_Next = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng).Offset(0, -StartExemptDate_Next).Value <> "L"
StartExemptDate_Next = StartExemptDate_Next + 1
Loop
EndExemptDate_Next = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng).Offset(0, EndExemptDate_Next).Value <> "L"
EndExemptDate_Next = EndExemptDate_Next + 1
Loop
StartDate_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Range(NextYear_StartRng).Offset(0, -StartExemptDate_Next + 1).Address
EndDate_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range _
(NextYear_StartRng).Offset(0, EndExemptDate_Next - 1).Address
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range(StartDate_Next, _
EndDate_Next).ClearContents: End If: End If: End If: End If
'Set active year:
With Range(StartDate, EndDate).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With Range(StartDate, EndDate)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(StartDate, EndDate).NumberFormat = "General"
Dim cell_RmvExempt As Range
For Each cell_RmvExempt In Range(StartDate, EndDate)
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell_RmvExempt
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.UpdateRemoteReferences = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
PleaseWait.Label2.Caption = ""
Unload PleaseWait
Application.Run "Sheet1.Worksheet_SelectionChange", Selection
End Sub
Private Sub CommandButton8_Click() 'Remove exemption
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim answer As Integer
answer = MsgBox("Are you sure you want to remove the selected duty exemption period for """ & Range("$B$" & Selection.Row).Value & """?", _
vbYesNo + vbExclamation, "Personnel Tracker")
If answer = vbYes Then
'Do Nothing
ElseIf answer = vbNo Then
Exit Sub
End If
Unload Edit_Exempt
'Note: No values required from the dialog box for exemption removal, thus can be safely unloaded.
PleaseWait.Show
PleaseWait.Label2.Caption = "Removing exemption ..."
DoEvents
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
'Check active year:
If Selection.Interior.ColorIndex = 37 Then
StartExemptDate = 0
Do Until Selection.Offset(0, -StartExemptDate).Interior.ColorIndex <> 37
StartExemptDate = StartExemptDate + 1
Loop
EndExemptDate = 0
Do Until Selection.Offset(0, EndExemptDate).Interior.ColorIndex <> 37
EndExemptDate = EndExemptDate + 1
Loop
Else: Exit Sub: End If
StartDate = Selection.Offset(0, -StartExemptDate + 1).Address
EndDate = Selection.Offset(0, EndExemptDate - 1).Address
'Check and set previous year:
If Left(Range(StartDate).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
If Not Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 < FirstYear_Val Then 'Check if greater than or equal to first generated year
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker"). _
Range("D2").Value - 1 & "").Cells, Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2) > 0 Then 'Check if person exists MAYBE USE THIS IF INSTEAD OF FIND???!!!
PrevYear_StartRng = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng).Value = "E" Then 'Check if exemption continues the first day of previous year
StartExemptDate_Prev = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng).Offset(0, -StartExemptDate_Prev).Value <> "E"
StartExemptDate_Prev = StartExemptDate_Prev + 1
Loop
EndExemptDate_Prev = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng).Offset(0, EndExemptDate_Prev).Value <> "E"
EndExemptDate_Prev = EndExemptDate_Prev + 1
Loop
StartDate_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Range(PrevYear_StartRng).Offset(0, -StartExemptDate_Prev + 1).Address
EndDate_Prev = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range _
(PrevYear_StartRng).Offset(0, EndExemptDate_Prev - 1).Address
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range(StartDate_Prev, _
EndDate_Prev).ClearContents: End If: End If: End If: End If
'Check and set following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
If Not Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 > FinalYear_Val Then 'Check if less than or equal to last generated year
If Not Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value).Value = "N/A" Then 'Check if person exists
NextYear_StartRng = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng).Value = "E" Then 'Check if exemption continues the first day of next year
StartExemptDate_Next = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng).Offset(0, -StartExemptDate_Next).Value <> "E"
StartExemptDate_Next = StartExemptDate_Next + 1
Loop
EndExemptDate_Next = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng).Offset(0, EndExemptDate_Next).Value <> "E"
EndExemptDate_Next = EndExemptDate_Next + 1
Loop
StartDate_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Range(NextYear_StartRng).Offset(0, -StartExemptDate_Next + 1).Address
EndDate_Next = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range _
(NextYear_StartRng).Offset(0, EndExemptDate_Next - 1).Address
ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range(StartDate_Next, _
EndDate_Next).ClearContents: End If: End If: End If: End If
'Set active year:
With Range(StartDate, EndDate).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.Italic = True
End With
With Range(StartDate, EndDate)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range(StartDate, EndDate).NumberFormat = "General"
Dim cell_RmvExempt As Range
For Each cell_RmvExempt In Range(StartDate, EndDate)
If Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 20 Then 'Week Day
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
ElseIf Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
cell_RmvExempt.Address, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$8").Interior.ColorIndex = 2 Then 'Weekend
With cell_RmvExempt.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16446700
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell_RmvExempt
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.UpdateRemoteReferences = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
PleaseWait.Label2.Caption = ""
Unload PleaseWait
Application.Run "Sheet1.Worksheet_SelectionChange", Selection
End Sub
Private Sub TextBox2_Enter() 'Start date - Enter Box
If Selection.Interior.ColorIndex = 15 Then
ExemptType = "leave"
ElseIf Selection.Interior.ColorIndex = 37 Then
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar As Long, secondChar As Long, count As Long
firstChar = InStr(str, "Current")
secondChar = InStr(firstChar, str, "-") + 1
count = secondChar - firstChar
rplc_ref = Mid(str, firstChar, count) 'First date
rplc_ref = Replace(Replace(rplc_ref, "Current " & ExemptType & " period: ", ""), "-", "")
Dim firstChar1 As Long, secondChar1 As Long, count1 As Long
firstChar1 = InStr(str, "Current")
secondChar1 = InStr(firstChar1, str, "-") + 1
count1 = secondChar1 - firstChar1
rplc_ref1 = Mid(str, secondChar1, count1) 'Second date
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox2.Value = "" Or Not IsDate(Edit_Exempt.TextBox2.Value) Then _
Edit_Exempt.TextBox2.Value = rplc_ref Else Edit_Exempt.TextBox2.Value = Format(Edit_Exempt.TextBox2.Value, "m/d/yyyy")
If Edit_Exempt.TextBox3.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "" Or Not IsDate(Edit_Exempt.TextBox3.Value) Then _
Edit_Exempt.TextBox3.Value = rplc_ref1 Else Edit_Exempt.TextBox3.Value = Format(Edit_Exempt.TextBox3.Value, "m/d/yyyy")
If Year(Edit_Exempt.TextBox2.Value) < FirstYear_Val Then 'Check if year doesn't exist.
MsgBox Year(Edit_Exempt.TextBox2.Value) & " and earlier does not exist.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox2.Value = "1/1/" & FirstYear_Val
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
ElseIf Year(Edit_Exempt.TextBox2.Value) > FinalYear_Val Then 'Check if year doesn't exist.
MsgBox Year(Edit_Exempt.TextBox2.Value) & " and later does not exist.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox3.Value = "12/" & Day(DateSerial(FinalYear_Val, 12 + 1, 1) - 1) & "/" & FinalYear_Val
Edit_Exempt.TextBox2.Value = DateAdd("y", -Worksheets("Formula & Code Data").Range("C16").Value + 1, Edit_Exempt.TextBox3.Value)
ElseIf Year(Edit_Exempt.TextBox2.Value) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Then 'Check if year is past the previous (year before last)
MsgBox "You cannot edit beyond the previous year.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox2.Value = "1/1/" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
ElseIf Year(Edit_Exempt.TextBox2.Value) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Then 'Check if year is past the following (year after next)
MsgBox "You cannot edit beyond the following year.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox3.Value = "12/" & Day(DateSerial(Worksheets("Troop to Task - Tracker").Range("D2").Value + 1, _
12 + 1, 1) - 1) & "/" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1
Edit_Exempt.TextBox2.Value = DateAdd("y", -Worksheets("Formula & Code Data").Range("C16").Value + 1, Edit_Exempt.TextBox3.Value)
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 > _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
MsgBox "You cannot set more than a year at a time.", vbExclamation, "Personnel Tracker"
If CDate(Edit_Exempt.TextBox3.Value) > CDate(Edit_Exempt.TextBox2.Value) Then
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
'Edit_Exempt.TextBox3.Value = DateAdd("y", Abs(DateDiff("d", Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) - 1, Edit_Exempt.TextBox2.Value)
Else: Edit_Exempt.TextBox2.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox3.Value): End If
'Edit_Exempt.TextBox2.Value = DateAdd("y", Abs(DateDiff("d", Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) - 1, Edit_Exempt.TextBox3.Value)
End If
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'Start date - Exit box
If Selection.Interior.ColorIndex = 15 Then
ExemptType = "leave"
ElseIf Selection.Interior.ColorIndex = 37 Then
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar As Long, secondChar As Long, count As Long
firstChar = InStr(str, "Current")
secondChar = InStr(firstChar, str, "-") + 1
count = secondChar - firstChar
rplc_ref = Mid(str, firstChar, count) 'First date
rplc_ref = Replace(Replace(rplc_ref, "Current " & ExemptType & " period: ", ""), "-", "")
Dim firstChar1 As Long, secondChar1 As Long, count1 As Long
firstChar1 = InStr(str, "Current")
secondChar1 = InStr(firstChar1, str, "-") + 1
count1 = secondChar1 - firstChar1
rplc_ref1 = Mid(str, secondChar1, count1) 'Second date
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox2.Value = "" Or Not IsDate(Edit_Exempt.TextBox2.Value) Then _
Edit_Exempt.TextBox2.Value = rplc_ref Else Edit_Exempt.TextBox2.Value = Format(Edit_Exempt.TextBox2.Value, "m/d/yyyy")
If Edit_Exempt.TextBox3.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "" Or Not IsDate(Edit_Exempt.TextBox3.Value) Then _
Edit_Exempt.TextBox3.Value = rplc_ref1 Else Edit_Exempt.TextBox3.Value = Format(Edit_Exempt.TextBox3.Value, "m/d/yyyy")
If Year(Edit_Exempt.TextBox2.Value) < FirstYear_Val Then 'Check if year doesn't exist.
MsgBox Year(Edit_Exempt.TextBox2.Value) & " and earlier does not exist.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox2.Value = "1/1/" & FirstYear_Val
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
ElseIf Year(Edit_Exempt.TextBox2.Value) > FinalYear_Val Then 'Check if year doesn't exist.
MsgBox Year(Edit_Exempt.TextBox2.Value) & " and later does not exist.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox3.Value = "12/" & Day(DateSerial(FinalYear_Val, 12 + 1, 1) - 1) & "/" & FinalYear_Val
Edit_Exempt.TextBox2.Value = DateAdd("y", -Worksheets("Formula & Code Data").Range("C16").Value + 1, Edit_Exempt.TextBox3.Value)
ElseIf Year(Edit_Exempt.TextBox2.Value) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Then 'Check if year is past the previous (year before last)
MsgBox "You cannot edit beyond the previous year.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox2.Value = "1/1/" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
ElseIf Year(Edit_Exempt.TextBox2.Value) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Then 'Check if year is past the following (year after next)
MsgBox "You cannot edit beyond the following year.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox3.Value = "12/" & Day(DateSerial(Worksheets("Troop to Task - Tracker").Range("D2").Value + 1, _
12 + 1, 1) - 1) & "/" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1
Edit_Exempt.TextBox2.Value = DateAdd("y", -Worksheets("Formula & Code Data").Range("C16").Value + 1, Edit_Exempt.TextBox3.Value)
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 > _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
MsgBox "You cannot set more than a year at a time.", vbExclamation, "Personnel Tracker"
If CDate(Edit_Exempt.TextBox3.Value) > CDate(Edit_Exempt.TextBox2.Value) Then
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
Else: Edit_Exempt.TextBox2.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox3.Value): End If
End If
End Sub
Private Sub TextBox3_Enter() 'End date - Enter box
If Selection.Interior.ColorIndex = 15 Then
ExemptType = "leave"
ElseIf Selection.Interior.ColorIndex = 37 Then
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar As Long, secondChar As Long, count As Long
firstChar = InStr(str, "Current")
secondChar = InStr(firstChar, str, "-") + 1
count = secondChar - firstChar
rplc_ref = Mid(str, firstChar, count) 'First date
rplc_ref = Replace(Replace(rplc_ref, "Current " & ExemptType & " period: ", ""), "-", "")
Dim firstChar1 As Long, secondChar1 As Long, count1 As Long
firstChar1 = InStr(str, "Current")
secondChar1 = InStr(firstChar1, str, "-") + 1
count1 = secondChar1 - firstChar1
rplc_ref1 = Mid(str, secondChar1, count1) 'Second date
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox2.Value = "" Or Not IsDate(Edit_Exempt.TextBox2.Value) Then _
Edit_Exempt.TextBox2.Value = rplc_ref Else Edit_Exempt.TextBox2.Value = Format(Edit_Exempt.TextBox2.Value, "m/d/yyyy")
If Edit_Exempt.TextBox3.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "" Or Not IsDate(Edit_Exempt.TextBox3.Value) Then _
Edit_Exempt.TextBox3.Value = rplc_ref1 Else Edit_Exempt.TextBox3.Value = Format(Edit_Exempt.TextBox3.Value, "m/d/yyyy")
If Year(Edit_Exempt.TextBox3.Value) < FirstYear_Val Then 'Check if year doesn't exist.
MsgBox Year(Edit_Exempt.TextBox3.Value) & " and earlier does not exist.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox2.Value = "1/1/" & FirstYear_Val
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
ElseIf Year(Edit_Exempt.TextBox3.Value) > FinalYear_Val Then 'Check if year doesn't exist.
MsgBox Year(Edit_Exempt.TextBox3.Value) & " and later does not exist.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox3.Value = "12/" & Day(DateSerial(FinalYear_Val, 12 + 1, 1) - 1) & "/" & FinalYear_Val
Edit_Exempt.TextBox2.Value = DateAdd("y", -Worksheets("Formula & Code Data").Range("C16").Value + 1, Edit_Exempt.TextBox3.Value)
ElseIf Year(Edit_Exempt.TextBox3.Value) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Then 'Check if year is past the previous (year before last)
MsgBox "You cannot edit beyond the previous year.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox2.Value = "1/1/" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
ElseIf Year(Edit_Exempt.TextBox3.Value) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Then 'Check if year is past the following (year after next)
MsgBox "You cannot edit beyond the following year.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox3.Value = "12/" & Day(DateSerial(Worksheets("Troop to Task - Tracker").Range("D2").Value + 1, _
12 + 1, 1) - 1) & "/" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1
Edit_Exempt.TextBox2.Value = DateAdd("y", -Worksheets("Formula & Code Data").Range("C16").Value + 1, Edit_Exempt.TextBox3.Value)
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 > _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
MsgBox "You cannot set more than a year at a time.", vbExclamation, "Personnel Tracker"
If CDate(Edit_Exempt.TextBox3.Value) > CDate(Edit_Exempt.TextBox2.Value) Then
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
Else: Edit_Exempt.TextBox2.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox3.Value): End If
End If
End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'End date - Exit box
If Selection.Interior.ColorIndex = 15 Then
ExemptType = "leave"
ElseIf Selection.Interior.ColorIndex = 37 Then
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar As Long, secondChar As Long, count As Long
firstChar = InStr(str, "Current")
secondChar = InStr(firstChar, str, "-") + 1
count = secondChar - firstChar
rplc_ref = Mid(str, firstChar, count) 'First date
rplc_ref = Replace(Replace(rplc_ref, "Current " & ExemptType & " period: ", ""), "-", "")
Dim firstChar1 As Long, secondChar1 As Long, count1 As Long
firstChar1 = InStr(str, "Current")
secondChar1 = InStr(firstChar1, str, "-") + 1
count1 = secondChar1 - firstChar1
rplc_ref1 = Mid(str, secondChar1, count1) 'Second date
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox2.Value = "" Or Not IsDate(Edit_Exempt.TextBox2.Value) Then _
Edit_Exempt.TextBox2.Value = rplc_ref Else Edit_Exempt.TextBox2.Value = Format(Edit_Exempt.TextBox2.Value, "m/d/yyyy")
If Edit_Exempt.TextBox3.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "" Or Not IsDate(Edit_Exempt.TextBox3.Value) Then _
Edit_Exempt.TextBox3.Value = rplc_ref1 Else Edit_Exempt.TextBox3.Value = Format(Edit_Exempt.TextBox3.Value, "m/d/yyyy")
If Year(Edit_Exempt.TextBox3.Value) < FirstYear_Val Then 'Check if year doesn't exist.
MsgBox Year(Edit_Exempt.TextBox3.Value) & " and earlier does not exist.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox2.Value = "1/1/" & FirstYear_Val
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
ElseIf Year(Edit_Exempt.TextBox3.Value) > FinalYear_Val Then 'Check if year doesn't exist.
MsgBox Year(Edit_Exempt.TextBox3.Value) & " and later does not exist.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox3.Value = "12/" & Day(DateSerial(FinalYear_Val, 12 + 1, 1) - 1) & "/" & FinalYear_Val
Edit_Exempt.TextBox2.Value = DateAdd("y", -Worksheets("Formula & Code Data").Range("C16").Value + 1, Edit_Exempt.TextBox3.Value)
ElseIf Year(Edit_Exempt.TextBox3.Value) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Then 'Check if year is past the previous (year before last)
MsgBox "You cannot edit beyond the previous year.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox2.Value = "1/1/" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
ElseIf Year(Edit_Exempt.TextBox3.Value) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Then 'Check if year is past the following (year after next)
MsgBox "You cannot edit beyond the following year.", vbExclamation, "Personnel Tracker"
Edit_Exempt.TextBox3.Value = "12/" & Day(DateSerial(Worksheets("Troop to Task - Tracker").Range("D2").Value + 1, _
12 + 1, 1) - 1) & "/" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1
Edit_Exempt.TextBox2.Value = DateAdd("y", -Worksheets("Formula & Code Data").Range("C16").Value + 1, Edit_Exempt.TextBox3.Value)
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 > _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
MsgBox "You cannot set more than a year at a time.", vbExclamation, "Personnel Tracker"
If CDate(Edit_Exempt.TextBox3.Value) > CDate(Edit_Exempt.TextBox2.Value) Then
Edit_Exempt.TextBox3.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox2.Value)
Else: Edit_Exempt.TextBox2.Value = DateAdd("y", Worksheets("Formula & Code Data").Range("C16").Value - 1, Edit_Exempt.TextBox3.Value): End If
End If
End Sub
Private Sub SpinButton2_SpinDown() 'Start Date - Down
If Selection.Interior.ColorIndex = 15 Then
ExemptType = "leave"
ElseIf Selection.Interior.ColorIndex = 37 Then
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar7 As Long, secondChar7 As Long, count7 As Long
firstChar7 = InStr(str, "Current")
secondChar7 = InStr(firstChar7, str, "-") + 1
count7 = secondChar7 - firstChar7
rplc_ref6 = Mid(str, secondChar7, count7) 'Second date
Dim firstChar8 As Long, secondChar8 As Long, count8 As Long
firstChar8 = InStr(str, "Current")
secondChar8 = InStr(firstChar8, str, "-") + 1
count8 = secondChar8 - firstChar8
rplc_ref7 = Mid(str, firstChar8, count8) 'First date
rplc_ref7 = Replace(Replace(rplc_ref7, "Current " & ExemptType & " period: ", ""), "-", "")
If Edit_Exempt.TextBox3.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "" Or Not IsDate(Edit_Exempt.TextBox3.Value) Then _
Edit_Exempt.TextBox3.Value = rplc_ref6
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox2.Value = "" Or Not IsDate(Edit_Exempt.TextBox2.Value) Then
Edit_Exempt.TextBox2.Value = rplc_ref7
ElseIf Year(DateAdd("d", -1, Edit_Exempt.TextBox2.Value)) < FirstYear_Val Then 'Check if year doesn't exist.
MsgBox Year(DateAdd("d", -1, Edit_Exempt.TextBox2.Value)) & " and earlier does not exist.", _
vbExclamation, "Personnel Tracker": TextBox2.SetFocus
ElseIf Year(DateAdd("d", -1, Edit_Exempt.TextBox2.Value)) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Then 'Check if year is past the previous (year before last)
MsgBox "You cannot edit beyond the previous year.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 >= _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
If DateDiff("d", Application.WorksheetFunction.Min(DateAdd("d", -1, Edit_Exempt.TextBox2.Value), Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(DateAdd("d", -1, Edit_Exempt.TextBox2.Value), Edit_Exempt.TextBox3.Value)) + 1 < _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if adding a day would be less than a year
Edit_Exempt.TextBox2.Value = DateAdd("d", -1, Edit_Exempt.TextBox2.Value)
Else: MsgBox "You cannot set more than a year at a time.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub: End If
Else: Edit_Exempt.TextBox2.Value = DateAdd("d", -1, Edit_Exempt.TextBox2.Value): End If
End Sub
Private Sub SpinButton2_SpinUp() 'Start Date - Up
If Selection.Interior.ColorIndex = 15 Then
ExemptType = "leave"
ElseIf Selection.Interior.ColorIndex = 37 Then
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar9 As Long, secondChar9 As Long, count9 As Long
firstChar9 = InStr(str, "Current")
secondChar9 = InStr(firstChar9, str, "-") + 1
count9 = secondChar9 - firstChar9
rplc_ref8 = Mid(str, firstChar9, count9) 'First date
rplc_ref8 = Replace(Replace(rplc_ref8, "Current " & ExemptType & " period: ", ""), "-", "")
Dim firstChar10 As Long, secondChar10 As Long, count10 As Long
firstChar10 = InStr(str, "Current")
secondChar10 = InStr(firstChar10, str, "-") + 1
count10 = secondChar10 - firstChar10
rplc_ref9 = Mid(str, secondChar10, count10) 'Second date
If Edit_Exempt.TextBox3.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "" Or Not IsDate(Edit_Exempt.TextBox3.Value) Then _
Edit_Exempt.TextBox3.Value = rplc_ref9
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox2.Value = "" Or Not IsDate(Edit_Exempt.TextBox2.Value) Then
Edit_Exempt.TextBox2.Value = rplc_ref8
ElseIf Year(DateAdd("d", 1, Edit_Exempt.TextBox2.Value)) > FinalYear_Val Then 'Check if year doesn't exist.
MsgBox Year(DateAdd("d", 1, Edit_Exempt.TextBox2.Value)) & " and later does not exist.", _
vbExclamation, "Personnel Tracker": TextBox2.SetFocus
ElseIf Year(DateAdd("d", 1, Edit_Exempt.TextBox2.Value)) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Then 'Check if year is past the following (year after next)
MsgBox "You cannot edit beyond the following year.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 >= _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
If DateDiff("d", Application.WorksheetFunction.Min(DateAdd("d", 1, Edit_Exempt.TextBox2.Value), Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(DateAdd("d", 1, Edit_Exempt.TextBox2.Value), Edit_Exempt.TextBox3.Value)) + 1 < _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if adding a day would be less than a year
Edit_Exempt.TextBox2.Value = DateAdd("d", 1, Edit_Exempt.TextBox2.Value)
Else: MsgBox "You cannot set more than a year at a time.", vbExclamation, "Personnel Tracker": TextBox2.SetFocus: Exit Sub: End If
Else: Edit_Exempt.TextBox2.Value = DateAdd("d", 1, Edit_Exempt.TextBox2.Value): End If
End Sub
Private Sub SpinButton1_SpinDown() 'End date - Down
If Selection.Interior.ColorIndex = 15 Then
ExemptType = "leave"
ElseIf Selection.Interior.ColorIndex = 37 Then
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar11 As Long, secondChar11 As Long, count11 As Long
firstChar11 = InStr(str, "Current")
secondChar11 = InStr(firstChar11, str, "-") + 1
count11 = secondChar11 - firstChar11
rplc_ref10 = Mid(str, firstChar11, count11) 'First date
rplc_ref10 = Replace(Replace(rplc_ref10, "Current " & ExemptType & " period: ", ""), "-", "")
Dim firstChar12 As Long, secondChar12 As Long, count12 As Long
firstChar12 = InStr(str, "Current")
secondChar12 = InStr(firstChar12, str, "-") + 1
count12 = secondChar12 - firstChar12
rplc_ref11 = Mid(str, secondChar12, count12) 'Second date
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox2.Value = "" Or Not IsDate(Edit_Exempt.TextBox2.Value) Then _
Edit_Exempt.TextBox2.Value = rplc_ref10
If Edit_Exempt.TextBox3.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "" Or Not IsDate(Edit_Exempt.TextBox3.Value) Then
Edit_Exempt.TextBox3.Value = rplc_ref11
ElseIf Year(DateAdd("d", -1, Edit_Exempt.TextBox3.Value)) < FirstYear_Val Then 'Check if year doesn't exist.
MsgBox Year(DateAdd("d", -1, Edit_Exempt.TextBox3.Value)) & " and earlier does not exist.", _
vbExclamation, "Personnel Tracker": TextBox3.SetFocus
ElseIf Year(DateAdd("d", -1, Edit_Exempt.TextBox3.Value)) <= Worksheets("Troop to Task - Tracker").Range("D2").Value - 2 Then 'Check if year is past the previous (year before last)
MsgBox "You cannot edit beyond the previous year.", vbExclamation, "Personnel Tracker": TextBox3.SetFocus
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 >= _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
If DateDiff("d", Application.WorksheetFunction.Min(DateAdd("d", -1, Edit_Exempt.TextBox3.Value), Edit_Exempt.TextBox2.Value), _
Application.WorksheetFunction.Max(DateAdd("d", -1, Edit_Exempt.TextBox3.Value), Edit_Exempt.TextBox2.Value)) + 1 < _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if adding a day would be less than a year
Edit_Exempt.TextBox3.Value = DateAdd("d", -1, Edit_Exempt.TextBox3.Value)
Else: MsgBox "You cannot set more than a year at a time.", vbExclamation, "Personnel Tracker": TextBox3.SetFocus: Exit Sub: End If
Else: Edit_Exempt.TextBox3.Value = DateAdd("d", -1, Edit_Exempt.TextBox3.Value): End If
End Sub
Private Sub SpinButton1_SpinUp() 'End date - Up
If Selection.Interior.ColorIndex = 15 Then
ExemptType = "leave"
ElseIf Selection.Interior.ColorIndex = 37 Then
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", vbExclamation, _
"Error - Personnel Tracker": Unload Edit_Exempt: Exit Sub: End If
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
Dim str As String: str = Edit_Exempt.Label4.Caption
Dim firstChar13 As Long, secondChar13 As Long, count13 As Long
firstChar13 = InStr(str, "Current")
secondChar13 = InStr(firstChar13, str, "-") + 1
count13 = secondChar13 - firstChar13
rplc_ref12 = Mid(str, firstChar13, count13) 'First date
rplc_ref12 = Replace(Replace(rplc_ref12, "Current " & ExemptType & " period: ", ""), "-", "")
Dim firstChar14 As Long, secondChar14 As Long, count14 As Long
firstChar14 = InStr(str, "Current")
secondChar14 = InStr(firstChar14, str, "-") + 1
count14 = secondChar14 - firstChar14
rplc_ref13 = Mid(str, secondChar14, count14) 'Second date
If Edit_Exempt.TextBox2.Value = "<Enter>" Or Edit_Exempt.TextBox2.Value = "" Or Not IsDate(Edit_Exempt.TextBox2.Value) Then _
Edit_Exempt.TextBox2.Value = rplc_ref12
If Edit_Exempt.TextBox3.Value = "<Enter>" Or Edit_Exempt.TextBox3.Value = "" Or Not IsDate(Edit_Exempt.TextBox3.Value) Then
Edit_Exempt.TextBox3.Value = rplc_ref13
ElseIf Year(DateAdd("d", 1, Edit_Exempt.TextBox3.Value)) > FinalYear_Val Then 'Check if year doesn't exist.
MsgBox Year(DateAdd("d", 1, Edit_Exempt.TextBox3.Value)) & " and later does not exist.", _
vbExclamation, "Personnel Tracker": TextBox3.SetFocus
ElseIf Year(DateAdd("d", 1, Edit_Exempt.TextBox3.Value)) >= Worksheets("Troop to Task - Tracker").Range("D2").Value + 2 Then 'Check if year is past the following (year after next)
MsgBox "You cannot edit beyond the following year.", vbExclamation, "Personnel Tracker": TextBox3.SetFocus
ElseIf DateDiff("d", Application.WorksheetFunction.Min(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value), _
Application.WorksheetFunction.Max(Edit_Exempt.TextBox2.Value, Edit_Exempt.TextBox3.Value)) + 1 >= _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if at 365/366 days (year/leap year days)
If DateDiff("d", Application.WorksheetFunction.Min(DateAdd("d", 1, Edit_Exempt.TextBox3.Value), Edit_Exempt.TextBox2.Value), _
Application.WorksheetFunction.Max(DateAdd("d", 1, Edit_Exempt.TextBox3.Value), Edit_Exempt.TextBox2.Value)) + 1 < _
Worksheets("Formula & Code Data").Range("C16").Value Then 'Check if adding a day would be less than a year
Edit_Exempt.TextBox3.Value = DateAdd("d", 1, Edit_Exempt.TextBox3.Value)
Else: MsgBox "You cannot set more than a year at a time.", vbExclamation, "Personnel Tracker": TextBox3.SetFocus: Exit Sub: End If
Else: Edit_Exempt.TextBox3.Value = DateAdd("d", 1, Edit_Exempt.TextBox3.Value): End If
End Sub
Private Sub UserForm_Initialize()
Dim FirstYear_Val As Integer: FirstYear_Val = Sheet4.Name
Dim FinalYear_Val As Integer: FinalYear_Val = Sheet7.Name
CancelLoad = 0
If Selection.Interior.ColorIndex = 15 Then
ExemptType = "leave"
ElseIf Selection.Interior.ColorIndex = 37 Then
ExemptType = "duty exemption"
Else: ExemptType = "leave/duty exemption": MsgBox "Error identifying " & ExemptType & " cell(s).", _
vbExclamation, "Error - Personnel Tracker": CancelLoad = 1: Exit Sub: End If
'Check active year:
LetterCheck = ""
If ExemptType = "leave" Then
LetterCheck = "L"
StartExemptDate = 0
Do Until Selection.Offset(0, -StartExemptDate).Interior.ColorIndex <> 15
StartExemptDate = StartExemptDate + 1
Loop
EndExemptDate = 0
Do Until Selection.Offset(0, EndExemptDate).Interior.ColorIndex <> 15
EndExemptDate = EndExemptDate + 1
Loop
ElseIf ExemptType = "duty exemption" Then
LetterCheck = "E"
StartExemptDate = 0
Do Until Selection.Offset(0, -StartExemptDate).Interior.ColorIndex <> 37
StartExemptDate = StartExemptDate + 1
Loop
EndExemptDate = 0
Do Until Selection.Offset(0, EndExemptDate).Interior.ColorIndex <> 37
EndExemptDate = EndExemptDate + 1
Loop
End If
StartDate = Selection.Offset(0, -StartExemptDate + 1).Address
EndDate = Selection.Offset(0, EndExemptDate - 1).Address
'Check previous year:
If Left(Range(StartDate).Offset(0, -1).Address, 3) = "$D$" Then 'Check if dates goes into previous year
If Not Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 < FirstYear_Val Then 'Check if greater than or equal to first generated year
If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker"). _
Range("D2").Value - 1 & "").Cells, Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2) > 0 Then 'Check if person exists MAYBE USE THIS IF INSTEAD OF FIND???!!!
PrevYear_StartRng = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -1).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng).Value = LetterCheck Then 'Check if exemption continues the last day of previous year
StartExemptDate_Prev = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value - 1 & "").Range( _
PrevYear_StartRng).Offset(0, -StartExemptDate_Prev).Value <> LetterCheck
StartExemptDate_Prev = StartExemptDate_Prev + 1
Loop
End If: End If: End If: End If
'Check following year:
'ADD CHECK FOR IF LAST YEAR DATA IS NOT PRESENT HERE!!!
If Worksheets("Troop to Task - Tracker").Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace _
(Replace(Replace(Replace(Replace(Range(EndDate).Offset(0, 1).Address, "1", ""), "2", ""), "3", ""), "4", ""), _
"5", ""), "6", ""), "7", ""), "8", ""), "9", ""), "0", ""), "$", "") & "$8").Value = "Staff Duty:" Then 'Check if dates goes into next year
If Not Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 > FinalYear_Val Then 'Check if less than or equal to last generated year
If Not Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value).Value = "N/A" Then 'Check if person exists
NextYear_StartRng = ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & ""). _
Cells.Find(What:=Worksheets("Troop to Task - Tracker").Range("E" & Selection.Row & ":E" & Selection.Row). _
Offset(0, Worksheets("Formula & Code Data").Range("C16").Value + 4).Formula2).Offset(0, -ThisWorkbook. _
Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range("B1").Value).Address
If ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value _
+ 1 & "").Range(NextYear_StartRng).Value = LetterCheck Then 'Check if exemption continues the first day of next year
EndExemptDate_Next = 0
Do Until ThisWorkbook.Sheets("" & Worksheets("Troop to Task - Tracker").Range("D2").Value + 1 & "").Range( _
NextYear_StartRng).Offset(0, EndExemptDate_Next).Value <> LetterCheck
EndExemptDate_Next = EndExemptDate_Next + 1
Loop
End If: End If: End If: End If
'Set initial date of active year:
On Error Resume Next
Active_Month_Start = Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
StartDate, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value
On Error Resume Next
Active_Month_End = Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
EndDate, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$4").MergeArea(1).Value
Month_Value_Start = 0
If Active_Month_Start = "January" Then Month_Value_Start = 1 Else If Active_Month_Start = "February" Then Month_Value_Start = 2 Else If Active_Month_Start = "March" Then Month_Value_Start = 3 _
Else If Active_Month_Start = "April" Then Month_Value_Start = 4 Else If Active_Month_Start = "May" Then Month_Value_Start = 5 Else If Active_Month_Start = "June" Then Month_Value_Start = 6 _
Else If Active_Month_Start = "July" Then Month_Value_Start = 7 Else If Active_Month_Start = "August" Then Month_Value_Start = 8 Else If Active_Month_Start = "September" Then Month_Value_Start = 9 _
Else If Active_Month_Start = "October" Then Month_Value_Start = 10 Else If Active_Month_Start = "November" Then Month_Value_Start = 11 Else If Active_Month_Start = "December" Then Month_Value_Start = 12
Month_Value_End = 0
If Active_Month_End = "January" Then Month_Value_End = 1 Else If Active_Month_End = "February" Then Month_Value_End = 2 Else If Active_Month_End = "March" Then Month_Value_End = 3 _
Else If Active_Month_End = "April" Then Month_Value_End = 4 Else If Active_Month_End = "May" Then Month_Value_End = 5 Else If Active_Month_End = "June" Then Month_Value_End = 6 _
Else If Active_Month_End = "July" Then Month_Value_End = 7 Else If Active_Month_End = "August" Then Month_Value_End = 8 Else If Active_Month_End = "September" Then Month_Value_End = 9 _
Else If Active_Month_End = "October" Then Month_Value_End = 10 Else If Active_Month_End = "November" Then Month_Value_End = 11 Else If Active_Month_End = "December" Then Month_Value_End = 12
On Error Resume Next
Active_Day_Start = Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
StartDate, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$7").MergeArea(1).Value
On Error Resume Next
Active_Day_End = Range("$" & Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
EndDate, "1", ""), "2", ""), "3", ""), "4", ""), "5", ""), "6", ""), "7", "") _
, "8", ""), "9", ""), "0", ""), "$", "") & "$7").MergeArea(1).Value
String_Start_Date = DateAdd("d", -StartExemptDate_Prev, Month_Value_Start & "/" & Active_Day_Start & "/" & Worksheets( _
"Troop to Task - Tracker").Range("D2").Value)
String_End_Date = DateAdd("d", EndExemptDate_Next, Month_Value_End & "/" & Active_Day_End & "/" & _
Worksheets("Troop to Task - Tracker").Range("D2").Value)
'Set labels:
Edit_Exempt.Label7.Caption = "Enter/toggle a changed " & ExemptType & " period or remove the selected " & ExemptType & " period, for """ & Range("B" & Selection.Row).Value & """ and selected date. (Date format: M/D/YYYY)"
Edit_Exempt.Label4.Caption = "Current " & ExemptType & " period: " & String_Start_Date & "-" & String_End_Date
Edit_Exempt.TextBox2.Value = "<Enter>"
Edit_Exempt.TextBox3.Value = "<Enter>"
If ExemptType = "leave" Then CommandButton10.Visible = False: CommandButton8.Visible = False Else If ExemptType = "duty exemption" Then CommandButton9.Visible = False: CommandButton2.Visible = False
End Sub
Private Sub UserForm_Activate()
If Edit_Exempt.CancelLoad = 1 Then Unload Edit_Exempt
End Sub
Sep 15 2021 10:29 PM
This is a very ... but very long debugging to find the error.
Unfortunately, I can't help without the file here, my knowledge of the error of regenerating this vba code without the corresponding workbook is limited.
My guess is that it could be due to one or the other user form of the error.
But there can also be a SUB - Seperate procedure that could be outside the user form and when the work folder is opened, the procedure runs immediately and no user form is found because it only opens afterwards, the error occurs.
This procedure could also be in another worksheet / module.
Anyway and as I said I am not a VBA guru, I would have to have the file (without sensitive data) to run the VBA code individually.
Thank you for your understanding and patience
NikolinoDE
I know I don't know anything (Socrates)