Forum Discussion
Need Help - Userform Error Resulting in Excel Crash - "Automation error Exception occurred"
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 tim...
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)
- NikolinoDE, thank you for the response! I use F8 all the time and won't help here since the error occurs at a whim before even getting into the code. Copying into a new workbook didn't help it. I couldn't find a way the link you provided could help my case since Alex (on StackOverflow) stated that without the UserForm, his/her code still worked without any issues. And, all my code is thoroughly verified and works fine but something is wrong with the UserForm, like Alex's case. Since I'm working in a single workbook, perhaps, it's a memory issue you think? Also, I wish I could provide helpful code but 1) it's all part of the UserForm containing 3,921 code lines, and 2) correlates to the overall workbook structure (900KB and 12,440 code lines)
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)
@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
