• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Count Distinct Days in Multiple Ranges

mrp

New Member
I have a spreadsheet with multiple date ranges (columns C & D). I would like to find a way to count the number of unique dates within all of the ranges displayed in the column. For example, 3/1-3/7 would count as 7 days and 3/8-3/15 would also count as 7 days but the multiple references to the same dates would not be counted. Is there a native way to do this or is VBA my only option?

Thanks in advance.
upload_2016-5-10_10-58-25.png
 
I'm going to say VBA. It might be possible, but would take some work. Problem with date ranges is that to XL, it only sees two numbers. We'd need to build an array with all 7 dates, compare that to each of the following rows, and keep track of overlaps.

Here's the UDF to do what you asked. After installing, formula would be:
=UniqueDates(C2:C10, D2:D10)

Code:
Function UniqueDates(rngStart As Range, rngEnd As Range)
Dim rngOverlap As Range
Dim i As Long

If rngStart.Cells.Count <> rngEnd.Cells.Count Then
    'Must have equal sized ranges
    UniqueDates = "N/A"
    Exit Function
End If

For i = 1 To rngStart.Cells.Count
    'We'll build a range that is correct size of each date range
    If rngOverlap Is Nothing Then
        Set rngOverlap = Range(Cells(rngStart(i).Value, 1), Cells(rngEnd(i).Value, 1))
    Else
        Set rngOverlap = Union(rngOverlap, Range(Cells(rngStart(i).Value, 1), Cells(rngEnd(i).Value, 1)))
    End If
Next i

UniqueDates = rngOverlap.Cells.Count

End Function
 
Hi Luke,

Thanks it works great! Is there a way to make the code ignore blanks? I get an #VALUE! error when blanks are present.

-m
 
Try
=CountDays(C2:D9)
Code:
Function CountDays(ByVal rng As Range) As Long
    Dim a, i As Long, ii As Long
    a = rng.Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a, 1)
            If (IsDate(a(i, 1))) * (IsDate(a(i, 2))) Then
                For ii = CLng(a(i, 1)) To CLng(a(i, 2))
                    .Item(CDate(ii)) = Empty
                Next
            ElseIf IsDate(a(i, 1)) Then
                .Item(a(i, 1)) = Empty
            ElseIf IsDate(a(i, 2)) Then
                .Item(a(i, 2)) = Empty
            End If
        Next
        CountDays = .Count
    End With
End Function
 
Back
Top