Days calculation between a range - algorithm

Question

I have the following problem
In a given range for example 1 Jan 2017 to 31 Jan 2017,
How many days of the following range events period occurred?
Example
1 range 1 Dec 2016 / 30 Jun 2017 = 31
2 range 1 Jan 2017 / 2 Jan 2017 = 2
3 range 4 Aug 2017 / 31 Aug 2017 = 0
4 range 24 Sep 2015 / 2 Jan 2017 = 2
5 range 6 Jan 2015 / 6 Feb 2016 = 0
Do you have some idea for an algorithm in access-VBA?
Many thanks

Answer 1

Public Function DaysInRange(vntRngStart As Date, vntRngEnd As Date, vntTestStart As Date, vntTestEnd As Date) As Integer
On Error GoTo PROC_ERR
Dim vntOverlapStart As Date
Dim vntOverlapEnd As Date
If vntRngStart > vntRngEnd Then
MsgBox "Main date range is specified back-to-front, swap the dates and try again.", vbInformation, "Invalid input..."
DaysInRange = -1
Exit Function
ElseIf vntTestStart > vntTestEnd Then
MsgBox "Test date range is specified back-to-front, swap the dates and try again.", vbInformation, "Invalid input..."
DaysInRange = -2
Exit Function
End If
If vntTestEnd < vntRngStart Or vntTestStart > vntRngEnd Then
'Either your test range ends before the given range starts,
'or the test range starts after the end of the given range,
'so there is no overlap between the two ranges.
DaysInRange = 0
Exit Function
End If
'So now we know that there must be some overlap
If vntTestStart <= vntRngStart Then
'Our test range starts before the start of the given range,
'so the overlap starts at the beginning of the given range
vntOverlapStart = vntRngStart
Else
'Our test range starts after the start of the given range,
'so the overlap starts at the beginning of the test range
vntOverlapStart = vntTestStart
End If
If vntTestEnd >= vntRngEnd Then
'Our test range ends after the end of the given range,
'so the overlap ends at the end of the given range
vntOverlapEnd = vntRngEnd
Else
'Our test range ends after the end of the given range,
'so the overlap ends at the end of the test range
vntOverlapEnd = vntTestEnd
End If
DaysInRange = DateDiff("d", vntOverlapStart, vntOverlapEnd) + 1
PROC_EXIT:
On Error Resume Next
Exit Function
PROC_ERR:
MsgBox "Error " & Err.Number & " in Function 'DaysInRange': " & Err.Description
Resume PROC_EXIT
End Function