VBA for checking Missing and Repeat Time

John

In the attached revised file, you'll see I have:

1. added new Sheet 2 (currently blank but with some headings) and
2. on Sheet 1...
   • added a new column for "Optional task name" (and a formula to write "Break" in column 4)
   • made some text changes (in red).
   • added a blue button captioned "Check for missing or overlapping times"

If (with macros enabled) you click that button, it will - on Sheet 2- sort the breaks and tasks in ascending order and add gap/ overlap comments (in columns E and F) plus colours. Hopefully this sorted list is more visual and so easier to understand.

Clicking that button runs this code (with explanatory comments):

Option Base 1
Dim Times As Variant, p As Long

Sub GetTimes()
    Dim FrstRw As Long, LstRw As Long, n As Long

    ' Declare first row for times and reset p
    FrstRw = 4
    p = 0

    'Get last used row in column B (2)
    With Sheet1
        LstRw = .Cells(.Rows.Count, 2).End(xlUp).Row
        ' Size array (with maximum rows, 4 columns)
        ReDim Times(LstRw - FrstRw + 1, 4) As Variant

        ' read from first to last row and add any time pairs to array
        For n = FrstRw To LstRw
        ' check if there's a time in columns 2 and 3
            If .Cells(n, 2).Value > 0 And .Cells(n, 3).Value > 0 Then
                ' if so, add values to array but first...
                ' ...increment array size counter
                p = p + 1
                Times(p, 1) = .Cells(n, 2)
                Times(p, 2) = .Cells(n, 3)
                Times(p, 3) = .Cells(n, 4)
                Times(p, 4) = .Cells(n, 5)
            End If
        Next n
        ' trim array, retaining values (transposing twice)
        Times = WorksheetFunction.Transpose(Times)
        ReDim Preserve Times(4, p)
        Times = WorksheetFunction.Transpose(Times)

    End With


    'paste sorted array
    With Sheet2
        ' clear any data and colours (except row 1)
        .UsedRange.Offset(1, 0).ClearContents
        .UsedRange.Offset(1, 0).Interior.ColorIndex = xlNone
        .Cells(2, 1).Resize(p, 4).Value = Times
        ' sort by start time
        .UsedRange.Offset(1, 0).Sort _
            Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlNo
        ' add sorted data to array
        Times = .UsedRange.Offset(1, 0)

        ' use sub to find time gaps
        Call FindTimeGaps

        ' use sub to find overlapped tasks
        Call FindOverlaps

        ' resize columns
        .Columns("A:F").AutoFit
        ' switch to results
        .Activate
        ' create borders
        .UsedRange.Borders.LineStyle = xlContinuous
    End With

    MsgBox p & " time pairs sorted by start (then end) times- see sheet 2"

End Sub

The lines in bold above call other procedures; this one find gaps between successive tasks:

Private Sub FindTimeGaps()
    Dim LstTime As Variant, n As Long

    'set last time
    LstTime = "21:00:00"

    With Sheet2
        'check first entry
        If .Cells(2, 1) > CDec(TimeValue("09:00:00")) Then
                .Cells(2, 5) = "Possible gap from 09:00 AM"
                ' make columns 1 and 5 yellow
                .Cells(1, 2).Interior.ColorIndex = 6
                .Cells(2, 5).Interior.ColorIndex = 6
        End If

        'loop down rows
        For n = 2 To p
            If CDec(.Cells(n + 1, 1)) > CDec(.Cells(n, 2) + TimeValue("00:01") * 1.0001) Then
                .Cells(n, 5) = "Possible gap from " & Format(.Cells(n, 2) + TimeValue("00:01"), "hh:mm AM/PM") & " to " & Format(.Cells(n + 1, 1) - TimeValue("00:01"), "hh:mm AM/PM")
                ' make columns 2 and 5 yellow
                .Cells(n, 2).Interior.ColorIndex = 6
                .Cells(n, 5).Interior.ColorIndex = 6
            End If
        Next n
        ' check last row
        If CDec(.Cells(n, 2)) < CDec(TimeValue(LstTime)) Then
            .Cells(n, 5) = "Gap from " & Format(.Cells(n, 2) + TimeValue("00:01"), "hh:mm AM/PM") & " to " & Format(LstTime, "hh:mm AM/PM")
            .Cells(n, 2).Interior.ColorIndex = 6
            .Cells(n, 5).Interior.ColorIndex = 6
        End If
    End With

End Sub

This detects the overlaps:

Private Sub FindOverlaps()

    With Sheet2
        'loop down rows
        For n = 1 To p
            'check array for later overlaps
            For m = 1 To p
                 If m <> n And ((Times(m, 1) < Times(n, 1) And Times(m, 2) > Times(n, 2)) _
                    Or (Times(m, 1) >= Times(n, 1) And Times(m, 2) <= Times(n, 2)) _
                    Or (Times(m, 1) < Times(n, 2) And Times(m, 2) > Times(n, 2))) _
                    Then
                    .Cells(m + 1, 6) = "Overlaps with task starting " & Format(Times(n, 1), "hh:mm AM/PM")
                    ' make columns 1 and 6 orange
                    .Cells(m + 1, 1).Interior.ColorIndex = 46
                    .Cells(m + 1, 6).Interior.ColorIndex = 46
'                    ' clear gap comment and colour
'                    .Cells(m + 1, 5) = ""
'                    .Cells(m + 1, 2).Interior.ColorIndex = xlNone
'                    .Cells(m + 1, 5).Interior.ColorIndex = xlNone
                End If
                ' stop if this start exceeds task n end
                If CDec(Times(m, 1)) > CDec(Times(n, 2)) + TimeValue("00:01") Then
                    Exit For
                End If
            Next m
        Next n

    End With

End Sub

where the key bit is an "If" test to detect the three possible overlap conditions:

1. task finishes within another task
2. task starts and finishes within another task
3. task starts within another task.

If you make the tasks on Sheet 1 longer (or smaller) to create overlaps (or gaps), you will need to click the button again to see new results.

Hope this solves your problem. If so, please be sure to mark this Answer as Selected.

@ john666,

I've put together a file that I think answers your questions.

Your first request was to have a macro to highlight entries which overlap in some way. There are 4 different types of overlap (I have explained this in the file). On the sheet "Revision" I have added a table which lists the pairs of time spans which overlap and which type of overlap it is.

Your second request was to have a macro to find cells missing a time entry. I have included one in the attached file, but in the attached file I have taken care of this using Conditional Formatting. If you delete a time entry the cell will turn purple. Likewise, if you enter a time value the cell fill goes away. 

There is also a "Reset" button which removes highlighting from the time columns and clears the "Overlap" table so you can do a re-check after any changes are made.

John_Ru has also provided an answer. After you look at both of them, please mark the one you like best as Selected.

Cheers   :-)