Excel Availability based on Date Ranges.

Copper Contributor

I am using a spreadsheet, to gain visibility on available staff. I have Start Dates and End Dates, creating Dates in the form of a range. I want to use these Date ranges, to auto fill open cells, if the staff member is scheduled during an overlapping range of dates. I would like it to fill the cell red, at a minimum. 

 

Formula to create Date Ranges : =TEXT(B2,"mmm d") & "-" & TEXT(B3,"mmm d")

 

Uranimal_0-1669174330559.png

 

Any assistance is appreciated.

3 Replies

@Uranimal Your example date ranges are curious, in that they each overlap -- so all staff member-by-date range cells in a row should be marked as "Unavailable" if any other such cell in that row contains "Assigned".

 

You don't say it explicitly, but you want the spreadsheet to react to changes in certain (staff member-related) cell content by conditionally changing the content of other cells in that row, based on the new value in the cell and the date ranges, but presumably not dependent on the content of cells for other staff members.

 

Changing the interior color to red for the "Unavailable" cells could be handled just by using conditional formatting. That's easy to do, though I do not recommend it in this case. And it does not do the date-related calculations that you want.

 

Determining which date ranges the staff member is unavailable for, and changing those cells to "Unavailable" + red is just part of the logic needed. While it might be possible with lengthy formulas, this situation calls for VBA code and a macro-enabled worksheet (though using code does mean you must think about security). I have written VBA code to do that determination. But beyond that requirement, think through these:

  1. If you* remove "Assigned" for a date range, all "Unavailable" cells dependent on that date range blocking (and has no blocking due to other date range assignments) should be cleared, and their interior color restored. I have written code for that, relying on the color for the Start Date cell.
  2. Will you record an additional notation (e.g., "Reserved") for dates that cannot be assigned, e.g., due to vacation or medical leave? The VBA code would need to treat such cell values differently. And if you do that, will you need to record additional, more-specific date ranges? An alternative is to include a second spreadsheet to record those restrictions, and make the overlapping date range logic refer to it as well (that's more complicated).
  3. What should happen if you enter other meaningful-to-you text** in one of these cells, and the code -- because of an assignment for that staff member that is recorded later -- determines that the cell should be flagged for blocking?
  4. What should happen if you overtype "Unavailable" with "Assigned", or anything else? I have written code to prevent that, using Excel's worksheet protection feature (without a password) and cells' Locked status. But in case you find its behavior somehow annoying, there is one line of code to turn it off.
  5. What should happen if you paste "Assigned" into multiple cells at once (or drag and copy), causing a conflict? Should the conflicting assignments be cleared or specially colored, or a warning message be issued?
  6. What should happen if you add a date range at the end (i.e., to the right)? What should happen if you add a date range in the middle?  Either of those could very much complicate the required code, so I have a suggestion: Include a button (with underlying code) to validate all the date ranges and then, if they are valid, recalculate availability for the entire worksheet.
  7. What should happen if you change one or more date ranges, in particular, if someone has already been assigned work in that range? I don't think I would want to write code (for free) that "remembers" the old date range and works out resulting data problems.

* you or any other person editing the spreadsheet, but I will continue to refer to "you"
** even a misspelling of Assigned (My code ignores differences in capitalization of this special word, and ignores leading and trailing spaces.)

 

To use the code I have written, you can (cautiously) use the attached workbook. Or, you can review the code below and add it to your workbook:

  1. Make a backup copy of your workbook.
  2. Save the workbook as a macro-enabled workbook (most likely with an .xlsm extension).
  3. Right-click the tab of your schedule worksheet. In the context (popup) menu that appears, click "View Code". The VBA Editor is opened to show code for that worksheet.
  4. At the top of the code window are two dropdown lists. The left one will initially read "(General)", and the right one "(Declarations)". Beneath them, in the code area, if you do not see the line "Option Explicit" (without the quotes), type it. That statement helps you detect and correct significant spelling errors in the code to follow.
  5. From the left dropdown list, select Worksheet. (Two/three lines of code are generated immediately for a Worksheet_SelectionChange procedure, but are not significant, and can be deleted later.)
  6. In the right dropdown list, select Change. More code is generated. So the code window should now appear like one of the following two images. (The upper one is Full-Module view; the lower one is Single-Procedure view. You can switch between the two using buttons at the bottom left of the code window.) Uranimal_1.jpg
  7. At this point, you may delete the Worksheet_SelectionChange procedure, but that's not required.
  8. Within the Worksheet_Change procedure, paste the following code: 

 

 

    '   The following values/objects, if calculated, do not
    '   change during one execution of this event handler.
    Dim in4BottomStaffRow   As Long
    Dim in4LastDateColumn   As Long
    Dim strLastDateColumn   As String
    Dim objRangeOfInterest  As Range
    Dim objUpdatedRange As Range    'that portion of the range of _
            interest that was updated
    
    '   The following values/objects may change multiple times
    '   during one execution of this event handler.
    Dim strCellAddress  As String
    Dim in4Row  As Long
    
    '----
    If mblnChangesAreDueToCode Then
        Exit Sub
    End If
    
    '----   Determine some characteristics of the worksheet.
    '   Find the bottom data row by looking for the last (consecutive)
    '   row with a non-blank Staff Member cell.
    strCellAddress = strCOL_STAFF_MEMBER & CStr(in4ROW_TOP_OF_STAFF)
    in4BottomStaffRow = Range(strCellAddress).End(xlDown).Row
    '   Find the last data column by looking for the last (consecutive)
    '   column with a non-blank cell in the row containing Start Dates.
    strCellAddress = strCOL_LEFTMOST_DATE & CStr(in4ROW_START_DATE)
    in4LastDateColumn = Range(strCellAddress).End(xlToRight).Column
    strCellAddress = Cells(1, in4LastDateColumn).Address
    strLastDateColumn = Mid$(strCellAddress, 2, _
            InStr(2, strCellAddress, "$") - 2)
    '  --
    Set objRangeOfInterest = Range(strCOL_LEFTMOST_DATE _
            & CStr(in4ROW_TOP_OF_STAFF) & ":" _
            & strLastDateColumn & CStr(in4BottomStaffRow))
    
    '----   See if any of the changed cells are in the range of interest.
    Set objUpdatedRange = Intersect(Target, objRangeOfInterest)
    If objUpdatedRange Is Nothing Then
        '...changes were made to the worksheet, but not within the
        '   range of interest.
    Else
        Call RecalculateBlocking(objUpdatedRange, in4LastDateColumn)
    End If​

 

 

9. Go back to the "(General)" section of code. After the "Option Explicit" statement, paste the following code: 

 

 

    '====   CONSTANTS
    '----   Structure of the Schedule worksheet:
    Private Const in4ROW_START_DATE As Long = 2
    Private Const in4ROW_END_DATE   As Long = 3
    Private Const in4ROW_TOP_OF_STAFF   As Long = 6
    Private Const strCOL_STAFF_MEMBER   As String = "A"
    Private Const strCOL_LEFTMOST_DATE  As String = "B"
    Private Const in4COL_LEFTMOST_DATE  As Long = 2
    '----
    Private Const blnUSE_WORKSHEET_PROTECTION As Boolean = False

    '====   MODULE-SCOPE VARIABLES
    Private mblnChangesAreDueToCode As Boolean​

 

 

10. Review the values in the "Private Const" statements at the top, and change them as needed to match your schedule worksheet. If you decide to use worksheet protection, you can later change the value of blnUSE_WORKSHEET_PROTECTION from False to True, but other changes to the worksheet must be made first.  Ask about those changes later if interested.

11. Paste the following procedures either before or after the Worksheet_Change procedure: 

 

 

Function DateRangesOverlap(ByVal StartDate1 As Date, ByVal EndDate1 As Date _
        , StartDate2 As Date, EndDate2 As Date) As Boolean

    Dim blnReturnValue  As Boolean
    
    '----
    If StartDate1 >= StartDate2 _
        And StartDate1 <= EndDate2 Then
        '...the first range starts within the second range.
        blnReturnValue = True
    ElseIf StartDate2 >= StartDate1 _
        And StartDate2 <= EndDate1 Then
        '...the second range starts within the first range.
        blnReturnValue = True
    '   These remaining checks are unlikely to be true, but the
    '   scheduling data could be badly constructed.
    ElseIf StartDate1 < StartDate2 _
        And EndDate1 > EndDate2 Then
        '...the first range completely encompasses the second.
        blnReturnValue = True
    ElseIf StartDate2 < StartDate1 _
        And EndDate2 > EndDate1 Then
        '...the second range completely encompasses the first.
        blnReturnValue = True
    Else
        blnReturnValue = False
    End If
    
    '----
    DateRangesOverlap = blnReturnValue
    Exit Function

End Function


Private Sub RecalculateBlocking(ByVal UpdatedRange As Range _
        , ByVal LastDateColumn As Long)
'   This procedure recalculates availability for the updated rows
'       (those included in the specified range).

'   Probably only one cell has changed, but the code has to
'       assume that multiple cells might have been changed.  Also,
'       as multiple cells for a staff member may contain "Assigned",
'       ...it gets complicated.

    Dim in4ColorOfBlockedDates  As Long
    '
    Dim colRowsToRecalc As Collection
    Dim vntRow  As Variant
    Dim in4Row  As Long
    Dim in4Col  As Long
    Dim in4ColToRight   As Long
    '
    Dim objCell     As Range
    Dim strCellContent  As String
    '
    Dim dteCheckStart   As Date
    Dim dteCheckEnd     As Date
    Dim dteAssignedStart    As Date
    Dim dteAssignedEnd      As Date
    
    '----
    in4ColorOfBlockedDates = vbRed
    '...or, an interior color for which it is easier to read black text:
    in4ColorOfBlockedDates = RGB(255, 75, 75)
    '  --
    Application.ScreenUpdating = False
    
    '----   Store the row numbers of rows with changes into a
    '       Collection object.
    Set colRowsToRecalc = New Collection
    For Each objCell In UpdatedRange
        in4Row = objCell.Row
        On Error Resume Next    '...to handle errors due to duplicates
        colRowsToRecalc.Add in4Row, Key:="R" & in4Row
        On Error GoTo 0
    Next objCell
    
    '----   For each of those rows (in any order)...
    If blnUSE_WORKSHEET_PROTECTION Then
        ActiveSheet.Unprotect
    End If
    For Each vntRow In colRowsToRecalc
        in4Row = vntRow
        If in4Row < in4ROW_TOP_OF_STAFF Then
            '   This should not happen, but if it does...
            GoTo ExamineNextRow
        End If
        '  --   Clear "Unavailable" cells in this row.
        in4Col = in4COL_LEFTMOST_DATE
        Do
            Set objCell = Cells(in4Row, in4Col)
            strCellContent = objCell.Value
            If StrComp(Trim$(strCellContent), "Unavailable" _
                    , vbTextCompare) = 0 Then   '...found one.
                mblnChangesAreDueToCode = True
                If blnUSE_WORKSHEET_PROTECTION Then
                    objCell.Locked = False
                End If
                objCell.Value = ""
                objCell.Interior.Color = Cells(1, in4Col).Interior.Color
                mblnChangesAreDueToCode = False
            End If
            '
            in4Col = in4Col + 1
        Loop Until in4Col > LastDateColumn
        '----   Then, working from left to right, calculate unavailability.
        in4Col = in4COL_LEFTMOST_DATE
        Do
            dteCheckStart = Cells(in4ROW_START_DATE, in4Col).Value
            dteCheckEnd = Cells(in4ROW_END_DATE, in4Col).Value
            Set objCell = Cells(in4Row, in4Col)
            strCellContent = Trim(objCell.Value)
            If StrComp(strCellContent, "Assigned", vbTextCompare) = 0 Then
                objCell.Interior.Color = Cells(in4ROW_START_DATE _
                        , in4Col).Interior.Color
                GoTo ExamineNextColumn
            End If
            '
            For in4ColToRight = 1 To LastDateColumn
                If in4ColToRight = in4Col Then
                    GoTo NextCheckForOverlap
                End If
                strCellContent = Cells(in4Row, in4ColToRight).Value
                If StrComp(Trim$(strCellContent), "Assigned" _
                        , vbTextCompare) = 0 Then
                    dteAssignedStart = Cells(in4ROW_START_DATE, in4ColToRight).Value
                    dteAssignedEnd = Cells(in4ROW_END_DATE, in4ColToRight).Value
                    If DateRangesOverlap(dteCheckStart, dteCheckEnd _
                            , dteAssignedStart, dteAssignedEnd) Then
                        Set objCell = Cells(in4Row, in4Col)
                        mblnChangesAreDueToCode = True
                        objCell.Value = "Unavailable"
                        objCell.Interior.Color = in4ColorOfBlockedDates
                        If blnUSE_WORKSHEET_PROTECTION Then
                            objCell.Locked = True
                        End If
                        mblnChangesAreDueToCode = False
                        Exit For
                    End If
                End If
NextCheckForOverlap:
            Next in4ColToRight
ExamineNextColumn:
            in4Col = in4Col + 1
        Loop Until in4Col > LastDateColumn
ExamineNextRow:
    Next vntRow
    If blnUSE_WORKSHEET_PROTECTION Then
        ActiveSheet.Protect
    End If
    '
    Application.ScreenUpdating = True

End Sub


Private Sub RecalculateBlockingForAll()
'   This procedure recalculates date-range blocking for all staff-
'       member rows.  It is appropriately used if a date range has
'       been changed or added

    Dim strCellAddress  As String
    Dim in4LastDateColumn   As Long
    
    '----   Find the last data column by looking for the last
    '       (consecutive) column with a non-blank cell in the
    '       row containing Start Dates.
    strCellAddress = strCOL_LEFTMOST_DATE & CStr(in4ROW_START_DATE)
    in4LastDateColumn = Range(strCellAddress).End(xlToRight).Column
    
    '----
    Call RecalculateBlocking(ActiveSheet.UsedRange, in4LastDateColumn)

End Sub​

 

 

Resave the workbook.  Then you are ready for testing.

@Uranimal Your example date ranges are curious, in that they each overlap -- so all staff member-by-date range cells in a row should be marked as "Unavailable" if any other such cell in that row contains "Assigned".

 

You don't say it explicitly, but you want the spreadsheet to react to changes in certain (staff member-related) cell content by conditionally changing the content of other cells in that row, based on the new value in the cell and the date ranges, but presumably not dependent on the content of cells for other staff members.

 

Changing the interior color to red for the "Unavailable" cells could be handled just by using conditional formatting. That's easy to do, though I do not recommend it in this case. And it does not do the date-related calculations that you want.

 

Determining which date ranges the staff member is unavailable for, and changing those cells to "Unavailable" + red is just part of the logic needed. While it might be possible with lengthy formulas, this calls for VBA code and a macro-enabled worksheet (though using code does mean you must think about security). I have written VBA code to do that determination. But beyond that requirement, think through these:

  1. If you* remove "Assigned" for a date range, all "Unavailable" cells dependent on that date range blocking (and has no blocking due to other date range assignments) should be cleared, and their interior color restored. I have written code for that, relying on the color for the Start Date cell.
  2. Will you record an additional notation (e.g., "Reserved") for dates that cannot be assigned, e.g., due to vacation or medical leave? The VBA code would need to treat such cell values differently. And if you do that, will you need to record additional, more-specific date ranges? An alternative is to include a second spreadsheet to record those restrictions, and make the overlapping date range logic refer to it as well (that's more complicated).
  3. What should happen if you enter other meaningful-to-you text** in one of these cells, and the code -- because of an assignment for that staff member that is recorded later -- determines that the cell should be flagged for blocking?
  4. What should happen if you overtype "Unavailable" with "Assigned", or anything else? I have written code to prevent that, using Excel's worksheet protection feature (without a password) and cells' Locked status. But in case you find its behavior somehow annoying, there is one line of code to turn it off.
  5. What should happen if you paste "Assigned" into multiple cells at once (or drag and copy), causing a conflict? Should the conflicting assignments be cleared or specially colored, or a warning message be issued?
  6. What should happen if you add a date range at the end? What should happen if you add a date range in the middle? Either of those could very much complicate the required code, so I have a suggestion: Include a button (with underlying code) to validate all the date ranges and then, if they are valid, recalculate availability for the entire worksheet.
  7. What should happen if you change one or more date ranges, in particular, if someone has already been assigned work in that range? I don't think I would want to write code (for free) that "remembers" the old date range and works out resulting data problems.

* you or any other person editing the spreadsheet, but I will continue to refer to "you"
** even a misspelling of Assigned (My code ignores differences in capitalization of this special word, and ignores leading and trailing spaces.)

 

To use the code I have written, you can (cautiously) use the attached workbook.Uranimal_0.png

Or, you can review the code below and add it to your workbook:

  1. Make a backup copy of your workbook.
  2. Save the workbook as a macro-enabled workbook (most likely with an .xlsm extension).
  3. Right-click the tab of your schedule worksheet. In the context (popup) menu that appears, click "View Code". The VBA Editor is opened to show code for that worksheet.
  4. At the top of the code window are two dropdown lists. The left one will initially read "(General)", and the right one "(Declarations)". Beneath them, in the code area, if you do not see the line "Option Explicit" (without the quotes), type it. That statement helps you detect and correct significant spelling errors in the code to follow.
  5. From the left dropdown list, select Worksheet. (Two/three lines of code are generated immediately for a Worksheet_SelectionChange procedure, but are not significant, and can be deleted later.)
  6. In the right dropdown list, select Change. More code is generated. So the code window should now appear like one of the following two images. (The upper one is Full-Module view; the lower one is (Single-)Procedure view. You can switch between the two using buttons at the bottom left of the code window.) Uranimal_1.jpg
  7. At this point, you may delete the Worksheet_SelectionChange procedure, but that's not required.
  8. Inside the Worksheet_Change procedure, paste the following code:

 

    '   The following values/objects, if calculated, do not
    '   change during one execution of this event handler.
    Dim in4BottomStaffRow   As Long
    Dim in4LastDateColumn   As Long
    Dim strLastDateColumn   As String
    Dim objRangeOfInterest  As Range
    Dim objUpdatedRange As Range    'that portion of the range of _
            interest that was updated
    
    '   The following values/objects may change multiple times
    '   during one execution of this event handler.
    Dim strCellAddress  As String
    Dim in4Row  As Long
    
    '----
    If mblnChangesAreDueToCode Then
        Exit Sub
    End If
    
    '----   Determine some characteristics of the worksheet.
    '   Find the bottom data row by looking for the last (consecutive)
    '   row with a non-blank Staff Member cell.
    strCellAddress = strCOL_STAFF_MEMBER & CStr(in4ROW_TOP_OF_STAFF)
    in4BottomStaffRow = Range(strCellAddress).End(xlDown).Row
    '   Find the last data column by looking for the last (consecutive)
    '   column with a non-blank cell in the row containing Start Dates.
    strCellAddress = strCOL_LEFTMOST_DATE & CStr(in4ROW_START_DATE)
    in4LastDateColumn = Range(strCellAddress).End(xlToRight).Column
    strCellAddress = Cells(1, in4LastDateColumn).Address
    strLastDateColumn = Mid$(strCellAddress, 2, _
            InStr(2, strCellAddress, "$") - 2)
    '  --
    Set objRangeOfInterest = Range(strCOL_LEFTMOST_DATE _
            & CStr(in4ROW_TOP_OF_STAFF) & ":" _
            & strLastDateColumn & CStr(in4BottomStaffRow))
    
    '----   See if any of the changed cells are in the range of interest.
    Set objUpdatedRange = Intersect(Target, objRangeOfInterest)
    If objUpdatedRange Is Nothing Then
        '...changes were made to the worksheet, but not within the
        '   range of interest.
    Else
        Call RecalculateBlocking(objUpdatedRange, in4LastDateColumn)
    End If

 

9. Go back to the "(General)" section of code. After the "Option Explicit" statement, paste the following code:

    '====   CONSTANTS
    '----   Structure of the Schedule worksheet:
    Private Const in4ROW_START_DATE As Long = 2
    Private Const in4ROW_END_DATE   As Long = 3
    Private Const in4ROW_TOP_OF_STAFF   As Long = 6
    Private Const strCOL_STAFF_MEMBER   As String = "A"
    Private Const strCOL_LEFTMOST_DATE  As String = "B"
    Private Const in4COL_LEFTMOST_DATE  As Long = 2
    '----
    Private Const blnUSE_WORKSHEET_PROTECTION As Boolean = False

    '====   MODULE-SCOPE VARIABLES
    Private mblnChangesAreDueToCode As Boolean


10. Review the values in the "Private Const" statements at the top, and change them as needed to match your schedule worksheet. If you decide to use worksheet protection, you can later change the value of blnUSE_WORKSHEET_PROTECTION from False to True, but other changes to the worksheet must be made first.  Ask about those changes if you are interested.


11. Paste the following procedures either before or after the Worksheet_Change procedure: 

Private Function DateRangesOverlap(ByVal StartDate1 As Date, ByVal EndDate1 As Date _
        , StartDate2 As Date, EndDate2 As Date) As Boolean

    Dim blnReturnValue  As Boolean
    
    '----
    If StartDate1 >= StartDate2 _
        And StartDate1 <= EndDate2 Then
        '...the first range starts within the second range.
        blnReturnValue = True
    ElseIf StartDate2 >= StartDate1 _
        And StartDate2 <= EndDate1 Then
        '...the second range starts within the first range.
        blnReturnValue = True
    '   These remaining checks are unlikely to be true, but the
    '   scheduling data could be badly constructed.
    ElseIf StartDate1 < StartDate2 _
        And EndDate1 > EndDate2 Then
        '...the first range completely encompasses the second.
        blnReturnValue = True
    ElseIf StartDate2 < StartDate1 _
        And EndDate2 > EndDate1 Then
        '...the second range completely encompasses the first.
        blnReturnValue = True
    Else
        blnReturnValue = False
    End If
    
    '----
    DateRangesOverlap = blnReturnValue
    Exit Function

End Function


Private Sub RecalculateBlocking(ByVal UpdatedRange As Range _
        , ByVal LastDateColumn As Long)
'   This procedure recalculates availability for the updated rows
'       (those included in the specified range).

'   Probably only one cell has changed, but the code has to
'       assume that multiple cells might have been changed.  Also,
'       as multiple cells for a staff member may contain "Assigned",
'       ...it gets complicated.

    Dim in4ColorOfBlockedDates  As Long
    '
    Dim colRowsToRecalc As Collection
    Dim vntRow  As Variant
    Dim in4Row  As Long
    Dim in4Col  As Long
    Dim in4ColToRight   As Long
    '
    Dim objCell     As Range
    Dim strCellContent  As String
    '
    Dim dteCheckStart   As Date
    Dim dteCheckEnd     As Date
    Dim dteAssignedStart    As Date
    Dim dteAssignedEnd      As Date
    
    '----
    in4ColorOfBlockedDates = vbRed
    '...or, an interior color for which it is easier to read black text:
    in4ColorOfBlockedDates = RGB(255, 75, 75)
    '  --
    Application.ScreenUpdating = False
    
    '----   Store the row numbers of rows with changes into a
    '       Collection object.
    Set colRowsToRecalc = New Collection
    For Each objCell In UpdatedRange
        in4Row = objCell.Row
        On Error Resume Next    '...to handle errors due to duplicates
        colRowsToRecalc.Add in4Row, Key:="R" & in4Row
        On Error GoTo 0
    Next objCell
    
    '----   For each of those rows (in any order)...
    If blnUSE_WORKSHEET_PROTECTION Then
        ActiveSheet.Unprotect
    End If
    For Each vntRow In colRowsToRecalc
        in4Row = vntRow
        If in4Row < in4ROW_TOP_OF_STAFF Then
            '   This should not happen, but if it does...
            GoTo ExamineNextRow
        End If
        '  --   Clear "Unavailable" cells in this row.
        in4Col = in4COL_LEFTMOST_DATE
        Do
            Set objCell = Cells(in4Row, in4Col)
            strCellContent = objCell.Value
            If StrComp(Trim$(strCellContent), "Unavailable" _
                    , vbTextCompare) = 0 Then   '...found one.
                mblnChangesAreDueToCode = True
                If blnUSE_WORKSHEET_PROTECTION Then
                    objCell.Locked = False
                End If
                objCell.Value = ""
                objCell.Interior.Color = Cells(1, in4Col).Interior.Color
                mblnChangesAreDueToCode = False
            End If
            '
            in4Col = in4Col + 1
        Loop Until in4Col > LastDateColumn
        '----   Then, working from left to right, calculate unavailability.
        in4Col = in4COL_LEFTMOST_DATE
        Do
            dteCheckStart = Cells(in4ROW_START_DATE, in4Col).Value
            dteCheckEnd = Cells(in4ROW_END_DATE, in4Col).Value
            Set objCell = Cells(in4Row, in4Col)
            strCellContent = Trim(objCell.Value)
            If StrComp(strCellContent, "Assigned", vbTextCompare) = 0 Then
                objCell.Interior.Color = Cells(in4ROW_START_DATE _
                        , in4Col).Interior.Color
                GoTo ExamineNextColumn
            End If
            '
            For in4ColToRight = 1 To LastDateColumn
                If in4ColToRight = in4Col Then
                    GoTo NextCheckForOverlap
                End If
                strCellContent = Cells(in4Row, in4ColToRight).Value
                If StrComp(Trim$(strCellContent), "Assigned" _
                        , vbTextCompare) = 0 Then
                    dteAssignedStart = Cells(in4ROW_START_DATE, in4ColToRight).Value
                    dteAssignedEnd = Cells(in4ROW_END_DATE, in4ColToRight).Value
                    If DateRangesOverlap(dteCheckStart, dteCheckEnd _
                            , dteAssignedStart, dteAssignedEnd) Then
                        Set objCell = Cells(in4Row, in4Col)
                        mblnChangesAreDueToCode = True
                        objCell.Value = "Unavailable"
                        objCell.Interior.Color = in4ColorOfBlockedDates
                        If blnUSE_WORKSHEET_PROTECTION Then
                            objCell.Locked = True
                        End If
                        mblnChangesAreDueToCode = False
                        Exit For
                    End If
                End If
NextCheckForOverlap:
            Next in4ColToRight
ExamineNextColumn:
            in4Col = in4Col + 1
        Loop Until in4Col > LastDateColumn
ExamineNextRow:
    Next vntRow
    If blnUSE_WORKSHEET_PROTECTION Then
        ActiveSheet.Protect
    End If
    Set colRowsToRecalc = Nothing
    
    '----
    Application.ScreenUpdating = True

End Sub


Private Sub RecalculateBlockingForAll()
'   This procedure recalculates date-range blocking for all staff-
'       member rows.  It is appropriately used if a date range has
'       been changed or added

    Dim strCellAddress  As String
    Dim in4LastDateColumn   As Long
    
    '----   Find the last data column by looking for the last
    '       (consecutive) column with a non-blank cell in the
    '       row containing Start Dates.
    strCellAddress = strCOL_LEFTMOST_DATE & CStr(in4ROW_START_DATE)
    in4LastDateColumn = Range(strCellAddress).End(xlToRight).Column
    
    '----
    Call RecalculateBlocking(ActiveSheet.UsedRange, in4LastDateColumn)

End Sub

 

12. Save your changes.  Now you are ready for testing.

 

[Replying again, because my earlier reply has disappeared.]

@SnowMan55 

 

Thank you for the amount of time you put into this. The spreadsheet I am using, was to have a pre-scheduling tool. Rather than fight with error messages and then trying to see where I need to make changes, in the current scheduling software. The current scheduling software, pulls the employees from availability, when they are on vacation/sick. Making it easier to schedule in the event they are out for whatever other reason. It just doesn't remove the individuals, if they are already scheduled. I had hoped, it would be a simple If>Then set of codes. I will take your information, and see how well I can implement it, and I appreciate the emphasis on being cautious.