civ1979, you may try running this on your worksheet.
Sub a()
Dim dic As Object, i As Long, d As Date
Set dic = CreateObject("scripting.dictionary")
dic.comparemode = 1
Application.ScreenUpdating = False
For i = 2 To Cells(rows.count, 1).End(xlUp).row
d = Cells(i, 4).Value
Do While d <= Cells(i, 5).Value
If d >= Cells(i, 1).Value Then
If Not dic.Exists(Cells(i, 3).Value & "_@_" & Format(d, "ddmmyyyy")) Then
dic.Item(Cells(i, 3).Value & "_@_" & Format(d, "ddmmyyyy")) = 1
Cells(i, 6).Value = Cells(i, 6).Value + 1
End If
End If
If d = Cells(i, 5).Value And Cells(i, 6).Value > 0 Then Cells(i, 6).Value = Cells(i, 6).Value - 1
d = d + 1
Loop
Next
Application.ScreenUpdating = True
dic.RemoveAll
Set dic = Nothing
End Sub
There are some ambiguity, especially for those where start and end dates are the same day; should that be 1 or 0 days?
Bookmarks