CODEWITHSUNDEEP
excelvbaalgorithmdatedata-structures
strajano
strajano

Reputation: 69

Date overlapping: generalized way to split the dates to get the overlapping interval?

Supose we have two date intervals:

A-------------B
       C-------------------------D

Where A and C are the begining dates, and B and D are the ending dates of the date intervals AB and CD.

I found that if (B+D)>=(A+C) we have date overlapping. But if (B+D)<(A+C), we do not have date overlapping.

What I was looking for, but with no sucess, it to figure out a generalized algorithm that return me the split set of the the date interval AB. In the case above, the split set of AB would be:

A----------(C-1) 'I mean, begining date of interval CD diminished by one day
C----------B     'The actual date overlapping

I am not looking for a algorithm that test every possible case, but a generalized algorithm that apply to any case.

Is this algorithm exist? I really apreciate any help!!!

The all cases I can figure out are (but I am not sure that are others):

A---------------B
    C--------------------D

             A---------------B
C--------------------D

A---------------B
    C------D

    A------B
C---------------D

A---------------B
C---------------D

      A--------B
C--------------D

A--------------B
     C---------D

A--------------B
C-------D

A-------B
C--------------D

EDIT

Based on brilliant chosen answer by Gary's Student, I was able to figure out my needed function, as follows. I do not need to know which one of the intervals inside the split set of resulting invervals is the overlaping one, but with some changes in the function this is easily acomplished.

Sub Test()
arr = fSplitOverlap( _
DateSerial(2020, 3, 1), DateSerial(2020, 3, 31), _
DateSerial(2020, 3, 1), DateSerial(2020, 3, 10))
For i = LBound(arr) To UBound(arr) Step 2
    Debug.Print arr(i), arr(i + 1)
Next i
End Sub


Function fSplitOverlap(ByVal Di1 As Date, ByVal Df1 As Date, _
ByVal Di2 As Date, ByVal Df2 As Date) As Variant

Dim arr() As Date

Dim DiOver As Date, DfOver As Date
Dim HaveFirsDisjoint1 As Boolean: HaveFirsDisjoint1 = False
DiOver = Application.WorksheetFunction.Max(Di1, Di2)
DfOver = Application.WorksheetFunction.Min(Df1, Df2)

'TEST OVERLAP
If DateDiff("d", DiOver, DfOver) >= 0 Then

    'TEST FIRST POSSIBLE DISJOINT INVERVAL
    If DateDiff("d", Di1, DateAdd("d", -1, DiOver)) >= 0 Then
        ReDim Preserve arr(1 To 4)
        arr(1) = Di1
        arr(2) = DateAdd("d", -1, DiOver)
        arr(3) = DiOver
        arr(4) = DfOver
        HaveFirsDisjoint1 = True
    End If

    'TEST SECOND POSSIBLE DISJOINT INVERVAL
    If DateDiff("d", DateAdd("d", 1, DfOver), Df1) >= 0 Then
        If HaveFirsDisjoint1 = True Then
            ReDim Preserve arr(1 To 6)
            arr(1) = Di1
            arr(2) = DateAdd("d", -1, DiOver)
            arr(3) = DiOver
            arr(4) = DfOver
            arr(5) = DateAdd("d", 1, DfOver)
            arr(6) = Df1
        Else
            ReDim Preserve arr(1 To 4)
            arr(1) = DiOver
            arr(2) = DfOver
            arr(3) = DateAdd("d", 1, DfOver)
            arr(4) = Df1
        End If
    End If

End If

fSplitOverlap = arr

End Function

Upvotes: 2

Views: 176

Answers (1)

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

Clearly from your pictures, if A>D or C>B then the regions are disjoint

Otherwise the overlap would be MIN(B,D) - MAX(A,C) + 1

So in VBA:

Sub Overlap()
    Dim A As Date, B As Date, C As Date, D As Date

    A = DateValue("1/11/2020")
    B = DateValue("1/20/2020")
    C = DateValue("1/15/2020")
    D = DateValue("2/13/2020")

    If A > D Or C > B Then
        MsgBox "no overlap"
        Exit Sub
    End If
    With Application.WorksheetFunction
        MsgBox .Min(B, D) - .Max(A, C) + 1
    End With
End Sub

Here the overlap is:

  1. 1/15
  2. 1/16
  3. 1/17
  4. 1/18
  5. 1/19
  6. 1/20

Upvotes: 1

Related Questions