Excel - Getting a Roster to highlight/identify gaps in a 24/7 roster

D

DavidGa

New Member
Joined
Jun 26, 2019
Messages
1
I have looked through some of the other questions on here and can't seem to find the answer so hope someone can help me, there is probably a simple fix to my issue and I am showing my limited knowledge regarding the functionality of excel.

I have a 24/7 roster that I would like to automatically show any gaps, currently this is done manually and is a painstaking task. An example of what a week would look like is below. The lines with the word SPARE can be ignored. Would there be a formula I could use to show the gaps between shifts in the bottom line? For example I can see that there is a 1545 to 2230 gap on the Sunday, but I currently would manually enter this.

[TABLE="width: 1811"]
<tbody>[TR]
[TD]w/c 22/09/2019[/TD]
[TD="colspan: 2"]Sunday[/TD]
[TD="colspan: 2"]Monday[/TD]
[TD="colspan: 2"]Tuesday[/TD]
[TD="colspan: 2"]Wednesday[/TD]
[TD="colspan: 2"]Thursday[/TD]
[TD="colspan: 2"]Friday[/TD]
[TD="colspan: 2"]Saturday[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]START[/TD]
[TD]FINISH[/TD]
[TD]START[/TD]
[TD]FINISH[/TD]
[TD]START[/TD]
[TD]FINISH[/TD]
[TD]START[/TD]
[TD]FINISH[/TD]
[TD]START[/TD]
[TD]FINISH[/TD]
[TD]START[/TD]
[TD]FINISH[/TD]
[TD]START[/TD]
[TD]FINISH[/TD]
[/TR]
[TR]
[TD]NAME[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]07:00[/TD]
[TD]15:45[/TD]
[TD]07:00[/TD]
[TD]15:45[/TD]
[TD]07:00[/TD]
[TD]15:45[/TD]
[TD]07:00[/TD]
[TD]15:45[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]22:30[/TD]
[TD]07:15[/TD]
[TD]22:30[/TD]
[TD]07:15[/TD]
[TD]22:30[/TD]
[TD]07:15[/TD]
[TD]22:30[/TD]
[TD]07:15[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]SPARE[/TD]
[TD][/TD]
[TD]SPARE[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]SPARE[/TD]
[TD][/TD]
[TD]SPARE[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]07:00[/TD]
[TD]15:45[/TD]
[TD]07:00[/TD]
[TD]15:45[/TD]
[TD]07:00[/TD]
[TD]15:45[/TD]
[TD]07:00[/TD]
[TD]15:45[/TD]
[TD]07:00[/TD]
[TD]15:45[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]22:30[/TD]
[TD]07:15[/TD]
[TD]22:30[/TD]
[TD]07:15[/TD]
[TD]22:30[/TD]
[TD]07:15[/TD]
[TD]22:30[/TD]
[TD]07:15[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]14:00[/TD]
[TD]22:45[/TD]
[TD]14:00[/TD]
[TD]22:45[/TD]
[TD]14:00[/TD]
[TD]22:45[/TD]
[TD]14:00[/TD]
[TD]22:45[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]07:30[/TD]
[TD]13:15[/TD]
[TD]07:30[/TD]
[TD]13:15[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]11:15[/TD]
[TD]17:45[/TD]
[TD]OFF[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]17:30[/TD]
[TD]22:45[/TD]
[TD]17:30[/TD]
[TD]22:45[/TD]
[TD]10:00[/TD]
[TD]15:30[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]GAPS:[/TD]
[TD="colspan: 2"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="colspan: 2"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="colspan: 2"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
This code worked on your test data. If it fails on other data, please post that data.
Put this code in a standard module in the workbook that contains your data.

Code: 
Option Explicit

Sub FindGaps()
    'https://www.mrexcel.com/forum/excel-questions/1102242-excel-getting-roster-highlight-identify-gaps-24-7-roster.html
    'Assume that all times are on or below row 3 and above the row containing 'Gaps'
    'Assume the day starts at 0700; 0700 corresponds to minute 0, 0659 the next day corresponds to minute 1440
    
    Dim lGapsRow As Long
    Dim lDayIndex As Long
    Dim lMinuteIndex As Long
    Dim ofound As Object
    Dim dteTimeStart As Date
    Dim dteTimeEnd As Date
    Dim lRowIndex As Long
    Dim lGapIndex As Long
    Dim aryGaps() As Variant
    Dim lPrevious As Long
    Dim lOutputRow As Long
    
    Const dteDayStart As Date = 7 / 24
    
    Dim oSD As Object
    Set oSD = CreateObject("Scripting.Dictionary")
    oSD.CompareMode = vbTextCompare
    
    Dim rngCell As Range
    Dim varK As Variant, varI As Variant, varTemp As Variant, lIndex As Long
    
    Set ofound = Columns("A:A").Find(What:="gaps", LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not ofound Is Nothing Then
        lGapsRow = ofound.Row
    Else
        MsgBox "No 'GAPS' row.  Add 'GAPS' in column below the last time line"
        GoTo End_Sub
    End If
    
    'Iterate each day
    For lDayIndex = 2 To 14 Step 2
        Set oSD = CreateObject("Scripting.Dictionary")
        oSD.CompareMode = vbTextCompare
        'Populate Scripting Dictionary
        For lMinuteIndex = 1 To 1440: oSD.Item(lMinuteIndex) = oSD.Item(lMinuteIndex) + 1: Next
        For lRowIndex = 3 To lGapsRow - 1
            If IsNumeric(Cells(lRowIndex, lDayIndex).Value) And Len(Cells(lRowIndex, lDayIndex).Value) > 0 Then
                dteTimeStart = Cells(lRowIndex, lDayIndex).Value - dteDayStart
                dteTimeEnd = Cells(lRowIndex, lDayIndex + 1).Value - dteDayStart
                If dteTimeEnd < dteTimeStart Then dteTimeEnd = 1
                For lMinuteIndex = 1440 * dteTimeStart To 1440 * dteTimeEnd
                    If oSD.exists(lMinuteIndex) Then oSD.Remove lMinuteIndex
                Next
            End If
        Next
        'Check for gaps
        If oSD.Count > 0 Then
            'some minutes not covered
            varK = oSD.keys
            lPrevious = -5: lGapIndex = 0
            For lMinuteIndex = 0 To oSD.Count - 1
                If varK(lMinuteIndex) <> lPrevious + 1 Then
                    lGapIndex = lGapIndex + 1
                    ReDim Preserve aryGaps(1 To 2, 1 To lGapIndex)
                    aryGaps(1, lGapIndex) = varK(lMinuteIndex)
                    If lGapIndex > 1 Then
                         aryGaps(2, lGapIndex - 1) = varK(lMinuteIndex - 1)
                    End If
                End If
                lPrevious = varK(lMinuteIndex)
                'Stop
                
            Next
            aryGaps(2, lGapIndex) = varK(lMinuteIndex - 1)
            
            lOutputRow = lGapsRow
            For lGapIndex = LBound(aryGaps, 2) To UBound(aryGaps, 2)
                With Cells(lGapsRow, lDayIndex)
                    If .MergeArea.Cells.Count > 1 Then .MergeCells = False
                    .Value = (aryGaps(1, lGapIndex) / 1440) + dteDayStart
                    .NumberFormat = "hh:mm"
                End With
                With Cells(lGapsRow, lDayIndex + 1)
                    If .MergeArea.Cells.Count > 1 Then .MergeCells = False
                    .Value = (aryGaps(2, lGapIndex) / 1440) + dteDayStart
                    .NumberFormat = "hh:mm"
                End With
                lGapsRow = lGapsRow + 1
            Next
        End If
    Next
End_Sub:
        
End Sub
 
Upvote 0
Correcting output alignment issues and making the gap times match the beginning and ending of the working times rather than the minute before or after the working times.

Code: 
Option Explicit

Sub FindGaps()
    'https://www.mrexcel.com/forum/excel-questions/1102242-excel-getting-roster-highlight-identify-gaps-24-7-roster.html
    'Assume that all times are on or below row 3 and above the row containing 'Gaps'
    'Assume the day starts at 0700; 0700 corresponds to minute 0, 0700 the next day corresponds to minute 1440
    
    Dim lGapsRow As Long
    Dim lDayIndex As Long
    Dim lMinuteIndex As Long
    Dim ofound As Object
    Dim dteTimeStart As Date
    Dim dteTimeEnd As Date
    Dim lRowIndex As Long
    Dim lGapIndex As Long
    Dim aryGaps() As Variant
    Dim lPrevious As Long
    Dim lOutputRow As Long
    Dim lMaxOutputRow As Long
    
    Const dteDayStart As Date = 7 / 24
    
    Dim oSD As Object
    Set oSD = CreateObject("Scripting.Dictionary")
    oSD.CompareMode = vbTextCompare
    
    Dim rngCell As Range
    Dim varK As Variant, varI As Variant, varTemp As Variant, lIndex As Long
    
    Set ofound = Columns("A:A").Find(What:="gaps", LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not ofound Is Nothing Then
        lGapsRow = ofound.Row
    Else
        MsgBox "No 'GAPS' row.  Add 'GAPS' in column A below the last time line"
        GoTo End_Sub
    End If
    
    'Iterate each day
    For lDayIndex = 2 To 14 Step 2
        Set oSD = CreateObject("Scripting.Dictionary")
        oSD.CompareMode = vbTextCompare
        'Populate Scripting Dictionary
        For lMinuteIndex = 0 To 1440: oSD.Item(lMinuteIndex) = oSD.Item(lMinuteIndex) + 1: Next
        For lRowIndex = 3 To lGapsRow - 1
            If IsNumeric(Cells(lRowIndex, lDayIndex).Value) And Len(Cells(lRowIndex, lDayIndex).Value) > 0 Then
                dteTimeStart = Cells(lRowIndex, lDayIndex).Value - dteDayStart
                dteTimeEnd = Cells(lRowIndex, lDayIndex + 1).Value - dteDayStart
                If dteTimeEnd < dteTimeStart Then dteTimeEnd = 1 + dteTimeEnd
                For lMinuteIndex = 1440 * dteTimeStart To 1440 * dteTimeEnd
                    If oSD.exists(lMinuteIndex) Then oSD.Remove lMinuteIndex
                Next
            End If
        Next
        'Check for gaps
        If oSD.Count > 0 Then
            'some minutes not covered
            varK = oSD.keys
            lPrevious = -5: lGapIndex = 0
            For lMinuteIndex = 0 To oSD.Count - 1
                If varK(lMinuteIndex) <> lPrevious + 1 Then
                    lGapIndex = lGapIndex + 1
                    ReDim Preserve aryGaps(1 To 2, 1 To lGapIndex)
                    aryGaps(1, lGapIndex) = varK(lMinuteIndex) - 1
                    If lGapIndex > 1 Then
                         aryGaps(2, lGapIndex - 1) = varK(lMinuteIndex - 1) + 1
                    End If
                End If
                lPrevious = varK(lMinuteIndex)
                'Stop
                
            Next
            aryGaps(2, lGapIndex) = varK(lMinuteIndex - 1) + 1
            If aryGaps(2, lGapIndex) > dteDayStart Then aryGaps(2, lGapIndex) = dteDayStart
            
            lOutputRow = lGapsRow
            For lGapIndex = LBound(aryGaps, 2) To UBound(aryGaps, 2)
                With Cells(lOutputRow, lDayIndex)
                    If .MergeArea.Cells.Count > 1 Then .MergeCells = False
                    .Value = (aryGaps(1, lGapIndex) / 1440) + dteDayStart
                    .NumberFormat = "hh:mm"
                End With
                With Cells(lOutputRow, lDayIndex + 1)
                    If .MergeArea.Cells.Count > 1 Then .MergeCells = False
                    .Value = (aryGaps(2, lGapIndex) / 1440) + dteDayStart
                    .NumberFormat = "hh:mm"
                End With
                lOutputRow = lOutputRow + 1
            Next
        End If
        If lOutputRow > lMaxOutputRow Then lMaxOutputRow = lOutputRow
    Next
    
    'Formatting
    With Range(Range("B3"), Cells(lMaxOutputRow, 15))
        .NumberFormat = "hh:mm"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    With Range(Range("A1"), Cells(lMaxOutputRow, 15))
        With .Font
            .Name = "Tahoma"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
    End With
    
    Range("A1:O2").HorizontalAlignment = xlCenter

End_Sub:
        
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Index+Match
Replies
4
Views
301
etaf
etaf
T
  • Solved
Looking for VBA Code to Conditionally Format Time Tracker on Entry
Replies
3
Views
192
Tara_A_Data
T
B
  • Question Question
Excel Pivot Table to see the number of "Lost Calls"
Replies
0
Views
64
Bernie Galve
B
D
  • Question Question
Formula help needed for working with days and times.
Replies
0
Views
316
dshtesy
D
tezza
  • Solved
Autosum specific rows and columns
Replies
2
Views
270
tezza
tezza

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top