Compare shorter date range against longer date range

[SauQ]

Hi Excel Gurus !

I am in need of a macro / formula which is able to find the missing date range(s).
Example:
John stayed in Apartment A&B for period : 1 February until 15 September.

Rental paid shown in records :
Apartment A rental period : 1 January until 28 February
Apartment B rental period : 1 April until 31 July
Apartment A rental again : 1 June until 31 August (overlaps)

The above start date - end date is keyed into cell A1:B3.

I need excel to show results :
1 March - 31 March
1 September - 15 September
which represent periods where no rental paid was shown in records.

My thousand thanks! in advance for any help on this.
SauQ

 

[Auric__]

I am in need of a macro / formula which is able to find the missing date
range(s). Example:
John stayed in Apartment A&B for period : 1 February until 15 September.

Rental paid shown in records :
Apartment A rental period : 1 January until 28 February
Apartment B rental period : 1 April until 31 July
Apartment A rental again : 1 June until 31 August (overlaps)

The above start date - end date is keyed into cell A1:B3.

I need excel to show results :
1 March - 31 March
1 September - 15 September
which represent periods where no rental paid was shown in records.

Not tested very thoroughly, but works with the above ranges (and tested
with a *very* small set of date ranges outside the above).

Sub findMissingDates()
On Error GoTo exiter
sd1 = CDate(InputBox("Start date?", , Date))
ed1 = CDate(InputBox("End date?", , Date))
ReDim dates(sd1 To ed1) As Boolean
For L0 = 1 To 3
'find missing dates
sd = CDate(Cells(L0, 1).Value)
ed = CDate(Cells(L0, 2).Value)
If sd < sd1 Then sd = sd1
If ed > ed1 Then ed = ed1
If (0 <> sd) And (0 <> ed) Then
For L1 = sd To ed
dates(L1) = True
Next
End If
Next
For L0 = sd1 To ed1
'report missing dates
If Not (dates(L0)) Then
For L1 = L0 + 1 To ed1
If dates(L1) Then Exit For
Next
While Len(ActiveCell.Formula)
ActiveCell.Offset(1, 0).Select
Wend
If ((L1) = ed1) And Not(dates(ed1)) Then
ActiveCell.Value = CDate(L0) & " to " & CDate(L1)
Exit Sub
Else
ActiveCell.Value = CDate(L0) & " to " & CDate(L1 - 1)
L0 = L1
End If
End If
Next
exiter:
End Sub

If the start & end dates for the overall period are specified somewhere on
the sheet, assign those values to sd1 and ed1 at the beginning of the sub
(and remove the two InputBox lines).

The locations for the individual rental dates are hardcoded in the first
For loop. (L0 is the rows.)

The missing dates are entered into whatever cell you have selected when
you run the sub. It will step down the sheet until it finds a blank cell
to work with. Where and how it reports the missing dates is handled in the
line starting with "ActiveCell.Value = CDate".

 

[SauQ]

SauQ wrote:














Not tested very thoroughly, but works with the above ranges (and tested

with a *very* small set of date ranges outside the above).



Sub findMissingDates()

On Error GoTo exiter

sd1 = CDate(InputBox("Start date?", , Date))

ed1 = CDate(InputBox("End date?", , Date))

ReDim dates(sd1 To ed1) As Boolean

For L0 = 1 To 3

'find missing dates

sd = CDate(Cells(L0, 1).Value)

ed = CDate(Cells(L0, 2).Value)

If sd < sd1 Then sd = sd1

If ed > ed1 Then ed = ed1

If (0 <> sd) And (0 <> ed) Then

For L1 = sd To ed

dates(L1) = True

Next

End If

Next

For L0 = sd1 To ed1

'report missing dates

If Not (dates(L0)) Then

For L1 = L0 + 1 To ed1

If dates(L1) Then Exit For

Next

While Len(ActiveCell.Formula)

ActiveCell.Offset(1, 0).Select

Wend

If ((L1) = ed1) And Not(dates(ed1)) Then

ActiveCell.Value = CDate(L0) & " to " & CDate(L1)

Exit Sub

Else

ActiveCell.Value = CDate(L0) & " to " & CDate(L1 - 1)

L0 = L1

End If

End If

Next

exiter:

End Sub



If the start & end dates for the overall period are specified somewhere on

the sheet, assign those values to sd1 and ed1 at the beginning of the sub

(and remove the two InputBox lines).



The locations for the individual rental dates are hardcoded in the first

For loop. (L0 is the rows.)



The missing dates are entered into whatever cell you have selected when

you run the sub. It will step down the sheet until it finds a blank cell

to work with. Where and how it reports the missing dates is handled in the

line starting with "ActiveCell.Value = CDate".



--

The idea is giving me brain cancer.



SauQ wrote:














Not tested very thoroughly, but works with the above ranges (and tested

with a *very* small set of date ranges outside the above).



Sub findMissingDates()

On Error GoTo exiter

sd1 = CDate(InputBox("Start date?", , Date))

ed1 = CDate(InputBox("End date?", , Date))

ReDim dates(sd1 To ed1) As Boolean

For L0 = 1 To 3

'find missing dates

sd = CDate(Cells(L0, 1).Value)

ed = CDate(Cells(L0, 2).Value)

If sd < sd1 Then sd = sd1

If ed > ed1 Then ed = ed1

If (0 <> sd) And (0 <> ed) Then

For L1 = sd To ed

dates(L1) = True

Next

End If

Next

For L0 = sd1 To ed1

'report missing dates

If Not (dates(L0)) Then

For L1 = L0 + 1 To ed1

If dates(L1) Then Exit For

Next

While Len(ActiveCell.Formula)

ActiveCell.Offset(1, 0).Select

Wend

If ((L1) = ed1) And Not(dates(ed1)) Then

ActiveCell.Value = CDate(L0) & " to " & CDate(L1)

Exit Sub

Else

ActiveCell.Value = CDate(L0) & " to " & CDate(L1 - 1)

L0 = L1

End If

End If

Next

exiter:

End Sub



If the start & end dates for the overall period are specified somewhere on

the sheet, assign those values to sd1 and ed1 at the beginning of the sub

(and remove the two InputBox lines).



The locations for the individual rental dates are hardcoded in the first

For loop. (L0 is the rows.)



The missing dates are entered into whatever cell you have selected when

you run the sub. It will step down the sheet until it finds a blank cell

to work with. Where and how it reports the missing dates is handled in the

line starting with "ActiveCell.Value = CDate".

Thank you, THANK YOU , thank you very much Auric !!

It works like a charm. I have approx 3000 employees who have a rental record span between 6 months and 5 years to sort out. Some of them have as much as 5 apartments through out their employment.

Your VBA is truly a life savior for me.

Thanks again!
SAUQ