Calculate the "true" duration of up/down times accounting for gaps and overlaps

[AOB]

As with all good problems, straightforward to define, not so straightforward to resolve...

I have a table of timestamps relating to a particular "widget" - start (date)times and end (date)times. I need to calculate the total duration per widget but taking into account that some records for a particular widget may overlap, and others may have gaps between them. Easiest to explain with an example...

Basic table shows each start and end time, with the Individual Duration easily calculated :

=[@[End Time]] - [@[Start Time]]

WidgetID	Start Time	End Time	Individual Duration
ABCD	06 Feb 2024 10:00	06 Feb 2024 14:00	04:00
ABCD	06 Feb 2024 16:00	06 Feb 2024 18:00	02:00
ABCD	06 Feb 2024 13:00	06 Feb 2024 17:00	04:00
ABCD	06 Feb 2024 22:00	06 Feb 2024 23:00	01:00

Obviously one can sum the individual durations for each record, per widget, using :

=SUMIFS([Individual Duration],[WidgetID],[@WidgetID])

WidgetID	Start Time	End Time	Individual Duration	Sum of Individual Durations
ABCD	06 Feb 2024 10:00	06 Feb 2024 14:00	04:00	11:00
ABCD	06 Feb 2024 16:00	06 Feb 2024 18:00	02:00	11:00
ABCD	06 Feb 2024 13:00	06 Feb 2024 17:00	04:00	11:00
ABCD	06 Feb 2024 22:00	06 Feb 2024 23:00	01:00	11:00

But that's incorrect because it overlooks the fact that there are overlaps between some of the records and they are being tuple-counted?

Obviously one can also just take the difference between the earliest start time and the latest end time, per widget, using :

=MAXIFS([End Time],[WidgetID],[@WidgetID])-MINIFS([Start Time],[WidgetID],[@WidgetID])

WidgetID	Start Time	End Time	Individual Duration	Max - Min Duration
ABCD	06 Feb 2024 10:00	06 Feb 2024 14:00	04:00	13:00
ABCD	06 Feb 2024 16:00	06 Feb 2024 18:00	02:00	13:00
ABCD	06 Feb 2024 13:00	06 Feb 2024 17:00	04:00	13:00
ABCD	06 Feb 2024 22:00	06 Feb 2024 23:00	01:00	13:00

But that's also incorrect because it overlooks the fact that there are gaps (e.g. between 18:00 and 22:00) and they are being included when they shouldn't be?

The correct answer should be 9 hours (8 hours from 10:00 to 18:00 with various overlaps, plus 1 hour from 22:00 to 23:00)

WidgetID	Start Time	End Time	Individual Duration	Actual Total Duration
ABCD	06 Feb 2024 10:00	06 Feb 2024 14:00	04:00	09:00
ABCD	06 Feb 2024 16:00	06 Feb 2024 18:00	02:00	09:00
ABCD	06 Feb 2024 13:00	06 Feb 2024 17:00	04:00	09:00
ABCD	06 Feb 2024 22:00	06 Feb 2024 23:00	01:00	09:00

So the challenge becomes, is it possible to construct a formula that can perform this calculation, preferably as a single column (although a reasonable finite number of helper columns would be acceptable) and preferably without relying on the data being sorted and ordered in a particular way first? Bear in mind the timestamps may cross over multiple dates (i.e. the start and end time for a particular row may not necessarily share the same day) and may be more granular than just hours (i.e. minutes and seconds) And there may be multiple widgets in the table (some may only appear once, others may appear any arbitrary number of times)

I reckon I could probably knock up a UDF in VBA to achieve this but would prefer to try to get it with a native formula first?

Thanks in advance for any suggestions or tips!

AOB

 

[AOB]

FYI - I threw together the below UDF which seems to work reasonably efficiently by recursively reducing the total set of periods down to an array of non-contiguous, non-overlapping periods, then simply summing each of those total durations. Each iteration of the recursion adjusts & removes a redundant period so that each successive call is working with a smaller array than the previous one, until all you are left with are the unique, all-encompassing periods.

But would definitely love to understand if this could be achieved with native formulas rather than UDF's if anybody has any ideas?

=GetTrueDuration([@WidgetID],[@[Start Time]],[@[End Time]])

WidgetID	Start Time	End Time	Net Duration per Widget
ABCD	06 Feb 2024 10:00	06 Feb 2024 14:00	09:00:00
ABCD	06 Feb 2024 16:00	06 Feb 2024 18:00	09:00:00
ABCD	06 Feb 2024 13:00	06 Feb 2024 17:00	09:00:00
ABCD	06 Feb 2024 22:00	06 Feb 2024 23:00	09:00:00
EFGH	10 Feb 2024 07:45	10 Feb 2024 11:00	05:45:00
EFGH	10 Feb 2024 09:30	10 Feb 2024 10:45	05:45:00
EFGH	10 Feb 2024 08:00	10 Feb 2024 12:00	05:45:00
EFGH	10 Feb 2024 15:00	10 Feb 2024 16:30	05:45:00

Option Explicit

Public Function GetTrueDuration(rngIdentifier As Range, rngStartDates As Range, rngEndDates As Range) As Variant

    On Error GoTo ErrorHandler
    
    Dim lso As ListObject
    Dim intTableOffset As Integer
    Dim varIdentifier As Variant
    Dim strIdentifier As String
    Dim strIdentifierColumnName As String
    Dim strStartDatesColumnName As String
    Dim strEndDatesColumnName As String
    Dim arrData As Variant
    Dim arrNonContiguousNonOverlapping As Variant
    Dim result As Variant
    Dim i As Long
    
    Set lso = rngIdentifier.ListObject
    
    If lso Is Nothing Then
        result = "Range must be in table form"
        GoTo Exit_GetTrueDuration
    End If
    
    intTableOffset = (lso.Range.Resize(, 1).Column - 1)
    varIdentifier = rngIdentifier.Value
    strIdentifier = IIf(TypeName(varIdentifier) = "String", Chr(34) & CStr(varIdentifier) & Chr(34), CStr(varIdentifier))
    strIdentifierColumnName = lso.ListColumns(rngIdentifier.Column - intTableOffset).Name
    strStartDatesColumnName = lso.ListColumns(rngStartDates.Column - intTableOffset).Name
    strEndDatesColumnName = lso.ListColumns(rngEndDates.Column - intTableOffset).Name
    
    arrData = Evaluate("=FILTER(CHOOSE({1,2}," & lso.Name & "[" & strStartDatesColumnName & "]," & lso.Name & "[" & strEndDatesColumnName & "]), " & lso.Name & "[" & strIdentifierColumnName & "]=" & strIdentifier & ")")
    arrData = Application.WorksheetFunction.Transpose(arrData)
    Call ReduceArray(arrData)
    
    result = 0
    For i = LBound(arrData, 2) To UBound(arrData, 2)
        result = result + CDbl(arrData(2, i) - arrData(1, i))
    Next i

Exit_GetTrueDuration:
    GetTrueDuration = result
    
ErrorHandler:
    result = "Formula Error"

End Function

Private Function ReduceArray(arrToReduce As Variant) As Variant

    On Error GoTo ErrorHandler

    Dim blnChanged As Boolean
    Dim i As Long
    Dim j As Long
    Dim result As Variant

    If IsEmpty(arrToReduce) Then GoTo Exit_ReduceArray

    blnChanged = False

    For i = LBound(arrToReduce, 2) To UBound(arrToReduce, 2)
        For j = i + 1 To UBound(arrToReduce, 2)
            ' 1) Is the focus period (i) wholly contained within the comparable period (j)?
            If arrToReduce(1, i) >= arrToReduce(1, j) And arrToReduce(2, i) <= arrToReduce(2, j) Then
                ' Yes, period (i) is wholly contained within period (j) - remove period (i) from the array (it is "covered" by period (j) already)
                Call DeleteElementAt(i, arrToReduce)
                blnChanged = True
            ' 2) Does the focus period (i) wholly contain the comparable period (j)?
            ElseIf arrToReduce(1, i) <= arrToReduce(1, j) And arrToReduce(2, i) >= arrToReduce(2, j) Then
                ' Yes, period (j) is wholly contained within period (i) - remove period (j) from the array (it is "covered" by period (i) already)
                Call DeleteElementAt(j, arrToReduce)
                blnChanged = True
            ' 3) Does the focus period (i) overlap with the comparable period (j) on the start side?
            ElseIf arrToReduce(1, i) < arrToReduce(1, j) And arrToReduce(2, i) >= arrToReduce(1, j) And arrToReduce(2, i) < arrToReduce(2, j) Then
                ' Yes, period (i) overlaps with period (j) on the start side - adopt the earlier start (i) into period (j) and remove period (i) (now "covered" by period (j))
                arrToReduce(1, j) = arrToReduce(1, i)
                Call DeleteElementAt(i, arrToReduce)
                blnChanged = True
            ' 4) Does the focus period (i) overlap with the comparable period (j) on the end side?
            ElseIf arrToReduce(1, i) < arrToReduce(2, j) And arrToReduce(2, i) >= arrToReduce(2, j) And arrToReduce(1, i) > arrToReduce(1, j) Then
                ' Yes, period (i) overlaps with period (j) on the end side - adopt the later end (i) into period (j) and remove period (i) (now "covered" by period (j))
                arrToReduce(2, j) = arrToReduce(2, i)
                Call DeleteElementAt(i, arrToReduce)
                blnChanged = True
            End If
            If blnChanged Then Exit For
        Next j
        If blnChanged Then Exit For
    Next i
    
    If blnChanged Then
        ' Repeat recursively until no changes are made to the array - thus leaving a list of distinct, non-overlapping, non-contiguous periods
        ReduceArray = ReduceArray(arrToReduce)
    Else
        ' No changes detected - bubble back up to previous iteration / return final reduced array to main subroutine
        result = arrToReduce
    End If

Exit_ReduceArray:
    ReduceArray = result
    Exit Function
    
ErrorHandler:
    result = Nothing
    Resume Exit_ReduceArray
    
End Function

Public Sub DeleteElementAt(ByVal index As Integer, ByRef arr As Variant)
    Dim i As Integer
    Dim j As Integer
    ' Move all element back one position
    For i = index + 1 To UBound(arr, 2)
        For j = LBound(arr, 1) To UBound(arr, 1)
            arr(j, i - 1) = arr(j, i)
        Next j
    Next
    ' Shrink the array by one, removing the last one
    ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(arr, 2) - 1)
End Sub