Determining whether a date is within a range

Question

I am taking a user input which consists of a from date and a to date. Those dates are compared against 4 cells in a row - a post date, pause date, resume date, and a close date. My goal with this code is to generate an array of rows with dates active within my date range.

Primary concern is if I followed the most effective logic for sorting and determining valid dates. Any comments on best practices would be appreciated.

Private Function DateRange() As Variant
Dim postcell As Range
Dim pausecell As Range
Dim unpausecell As Range
Dim closecell As Range
Dim arr_validRows() As Variant
Dim ws As Worksheet

Set ws = Sheets(1)

ReDim arr_validRows(0) As Variant
Dim z As Range
For Each z In ws.Range("D3:D" & ws.Cells(ws.Rows.Count, 2).End(xlUp).row)
    Set postcell = z
    Set pausecell = z.Offset(0, 1)
    Set unpausecell = z.Offset(0, 2)
    Set closecell = z.Offset(0, 3)

    If Not closecell.Value = "?" Then
        If CDate(postcell.Value) <= this.ToDate Then
            If Not pausecell.Value = "" Then
                If CDate(pausecell.Value) >= this.FromDate Then

                    ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
                    arr_validRows(UBound(arr_validRows)) = z.row

                ElseIf CDate(pausecell.Value) < this.FromDate And CDate(unpausecell.Value) >= this.FromDate Then

                    ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
                    arr_validRows(UBound(arr_validRows)) = z.row

                End If
            Else
                If CDate(closecell.Value) >= this.FromDate Then

                    ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
                    arr_validRows(UBound(arr_validRows)) = z.row

                End If
            End If
        End If
    End If
Next z

DateRange = arr_validRows
End Function

Below is the full class module that this function is contained in. The AddToReports()sub is where the DateRange() function is called.

Class: Report_Generator

Option Explicit

Private Type Reports
    RequisitionNumber As String
    FromDate As Date
    ToDate As Date
    JobTitle As String
    JobLocation As String
    JobCategory As String
    RecruiterName As String
    TSViews As Long
    TSApplicants As Long
End Type
Private this As Reports
Public Property Let RequisitionNumber(ByVal inputValue As String)
    this.RequisitionNumber = inputValue
End Property
Public Property Get RequisitionNumber() As String
    RequisitionNumber = this.RequisitionNumber
End Property

Public Property Let JobTitle(ByVal inputValue As String)
    this.JobTitle = inputValue
End Property
Public Property Get JobTitle() As String
    JobTitle = this.JobTitle
End Property
Public Property Let JobLocation(ByVal inputValue As String)
    this.JobLocation = inputValue
End Property
Public Property Get JobLocation() As String
    JobLocation = this.JobLocation
End Property
Public Property Let JobCategory(ByVal inputValue As String)
    this.JobCategory = inputValue
End Property
Public Property Get JobCategory() As String
    JobCategory = this.JobCategory
End Property
Public Property Let RecruiterName(ByVal inputValue As String)
    this.RecruiterName = inputValue
End Property
Public Property Get RecruiterName() As String
    RecruiterName = this.RecruiterName
End Property
Public Property Get TSViews() As Long
    TSViews = this.TSViews
End Property
Public Property Get TSApplicants() As Long
    TSApplicants = this.TSApplicants
End Property
Public Property Get FromDate() As String
    FromDate = this.FromDate
End Property
Public Property Let FromDate(ByVal inputValue As String)
    this.FromDate = inputValue
End Property
Public Property Get ToDate() As String
    ToDate = this.ToDate
End Property
Public Property Let ToDate(ByVal inputValue As String)
    this.ToDate = inputValue
End Property

Private Function DateRange() As Variant
    Dim postcell As Range
    Dim pausecell As Range
    Dim unpausecell As Range
    Dim closecell As Range
    Dim arr_validRows() As Variant
    Dim ws As Worksheet

    Set ws = Sheets(1)

    ReDim arr_validRows(0) As Variant
    Dim z As Range
    For Each z In ws.Range("D3:D" & ws.Cells(ws.Rows.Count, 2).End(xlUp).row)
        Set postcell = z
        Set pausecell = z.Offset(0, 1)
        Set unpausecell = z.Offset(0, 2)
        Set closecell = z.Offset(0, 3)

        If Not closecell.Value = "?" Then
            If CDate(postcell.Value) <= this.ToDate Then
                If Not pausecell.Value = "" Then
                    If CDate(pausecell.Value) >= this.FromDate Then

                        ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
                        arr_validRows(UBound(arr_validRows)) = z.row

                    ElseIf CDate(pausecell.Value) < this.FromDate And CDate(unpausecell.Value) >= this.FromDate Then

                        ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
                        arr_validRows(UBound(arr_validRows)) = z.row

                    End If
                Else
                    If CDate(closecell.Value) >= this.FromDate Then

                        ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
                        arr_validRows(UBound(arr_validRows)) = z.row

                    End If
                End If
            End If
        End If
    Next z

    DateRange = arr_validRows
End Function

Sub AddToReport(ByVal sheetname As String)
    Dim ws As Worksheet
    Dim newrow As Long
    Set ws = Sheets(1)

    Dim exists As Boolean
    exists = False

    Dim i As Integer
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = sheetname Then
            exists = True
         End If
    Next i

    If Not exists Then
        Call CreateSheet(sheetname)

        With ThisWorkbook.Worksheets(sheetname)
            .Range("1:1").Value = ws.Range("2:2").Value
        End With
    End If


    Dim array_rows() As Variant
    array_rows = DateRange()

    Dim z As Variant
    Dim w As Integer
    For z = 1 To UBound(array_rows)

        If z <= UBound(array_rows) Then
            With ThisWorkbook.Worksheets(sheetname)
                newrow = .Cells(.Rows.Count, 2).End(xlUp).row + 1

                .Range(newrow & ":" & newrow).Value = ws.Range(array_rows(z) & ":" & array_rows(z)).Value
            End With
        Else
            Exit For
        End If
    Next z

End Sub

Sub TimeSeriesSummation()
'Still in progress
End Sub

Sub AdvancedFilters( _
    ByVal reqnum_on As Boolean, _
    ByVal jobcategory_on As Boolean, _
    ByVal recruiter_on As Boolean, _
    ByVal jobtitle_on As Boolean, _
    ByVal joblocation_on As Boolean, _
    ByVal sheetname As String)

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(sheetname)

    With ws.Range("A:O")
        ws.AutoFilterMode = False
        If reqnum_on Then
            'field 1
            .AutoFilter field:=1, Criteria1:="<>" & this.RequisitionNumber
        End If

        If jobcategory_on Then
            'field 13
            .AutoFilter field:=13, Criteria1:="<>" & this.JobCategory
        End If

        If recruiter_on Then
            'field 14
            .AutoFilter field:=14, Criteria1:="<>" & this.RecruiterName
        End If

        If jobtitle_on Then
            'field 2
            .AutoFilter field:=2, Criteria1:="<>" & this.JobTitle
        End If

        If joblocation_on Then
            'field 3
            .AutoFilter field:=3, Criteria1:="<>" & this.JobLocation
        End If
    End With

    If reqnum_on Or jobcategory_on Or recruiter_on Or jobtitle_on Or joblocation_on Then
        ws.Range("B2:B" & ws.Cells(ws.Rows.Count, 2).End(xlUp).row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        ws.AutoFilterMode = False
    End If

End Sub

Private Sub CreateSheet(ByVal sheetname As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = sheetname
End Sub

Sub Statistics(ByVal sheetname As String)
    With ThisWorkbook.Worksheets(sheetname)
        .Range("Q3").Value = "Descriptive Statistics"
        .Range("Q4").Value = "Mean"
        .Range("Q5").Value = "Median"
        .Range("Q6").Value = "Std. Dev."
        .Range("Q7").Value = "Variance"

        .Range("R3").Value = "Total Days Active"
        .Range("S3").Value = "Views"
        .Range("T3").Value = "Applications"
        .Range("U3").Value = "Views-To-Applications"
        .Range("V3").Value = "Applications per Day"

        .Range("R4").Value = "=AVERAGE(H$2:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"
        .Range("R5").Value = "=MEDIAN(H$2:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"
        .Range("R6").Value = "=STDEVP(H$2:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"
        .Range("R7").Value = "=VARP(H$2:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"

        Dim sourceRange As Range
        Dim fillRange As Range
        Set sourceRange = .Range("R4:R7")
        Set fillRange = .Range("R4:V7")

        Call sourceRange.AutoFill(fillRange)

        .Range("R4:R7").NumberFormat = "0.00"
        .Range("S4:S7").NumberFormat = "0.00"
        .Range("T4:T7").NumberFormat = "0.00"
        .Range("U4:U7").NumberFormat = "0.00%"
        .Range("V4:V7").NumberFormat = "0.00"


    End With
End Sub

Sub FormatColumns(ByVal sheetname As String)
    With ThisWorkbook.Worksheets(sheetname)
        .Range("H:H").NumberFormat = "0.00"
        .Range("I:I").NumberFormat = "0"
        .Range("J:J").NumberFormat = "0"
        .Range("K:K").NumberFormat = "0.00%"
        .Range("L:L").NumberFormat = "0.00"

        .Columns("Q:W").EntireColumn.AutoFit
        .Columns("A:N").EntireColumn.AutoFit
        .Columns("E:G").EntireColumn.Hidden = True
    End With
End Sub

And just to provide even further context, below is the sub that is called when the user form is submitted.

Private Sub GenerateReportButton_Click()
    Application.ScreenUpdating = False
    Call ReportGenerator
    Application.ScreenUpdating = True

    If TotalsButton.Value Then
        Unload Me
    End If
End Sub

Sub ReportGenerator()
    Dim reqnum_on As Boolean
    Dim jobtitle_on As Boolean
    Dim joblocation_on As Boolean
    Dim jobcategory_on As Boolean
    Dim recruiter_on As Boolean
    Dim sheetname As String
    Dim Reports As Report_Generator

    Set Reports = New Report_Generator

    With Reports
        .RequisitionNumber = ReqNumBox.Text
        .FromDate = CDate(FromBox.Text)
        .ToDate = CDate(ToBox.Text)
        .JobTitle = (JobTitleBox.Text)
        .JobLocation = JobLocationBox.Text
        .JobCategory = JobCategoryComboBox.Text
        .RecruiterName = RecruiterComboBox.Text
    End With

    reqnum_on = False
    jobtitle_on = False
    joblocation_on = False
    jobcategory_on = False
    recruiter_on = False

    sheetname = Left(Format(Reports.FromDate, "mmm d") & " to " & Format(Reports.ToDate, "mmm d") & " ", 31)

    If Not Reports.RequisitionNumber = "" Then
        reqnum_on = True
        sheetname = Left(sheetname & "RQ", 31)
    End If

    If Not Reports.JobTitle = "" Then
        jobtitle_on = True
        sheetname = Left(sheetname & "JT", 31)
    End If

    If Not Reports.JobLocation = "" Then
        joblocation_on = True
        sheetname = Left(sheetname & "JL", 31)
    End If

    If Not Reports.JobCategory = "" Then
        jobcategory_on = True
        sheetname = Left(sheetname & "JC", 31)
    End If

    If Not Reports.RecruiterName = "" Then
        recruiter_on = True
        sheetname = Left(sheetname & "RN", 31)
    End If

    Reports.AddToReport (sheetname)
    Reports.AdvancedFilters reqnum_on, jobcategory_on, recruiter_on, jobtitle_on, joblocation_on, sheetname
    Reports.Statistics (sheetname)
    Reports.FormatColumns (sheetname)


End Sub

Answer 1

DateRange() function

Array handling

You have a bug. The first element of arr_validRows will never be populated, because you give yourself a single element on this line...

ReDim arr_validRows(0) As Variant

...but when you add items to the array, you increase the bound before you add the new item:

ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
arr_validRows(UBound(arr_validRows)) = z.row 

This means that the calling function doesn't have an easy way to determine if there are any results other than the non-obvious method of checking to see if there are 2 items in the returned array. Since you are returning a Variant, I would suggest returning either vbEmpty or some other non-array value if there are no results - this makes checking the return value simply IsArray(foo).

Still on the topic of arrays, resizing arrays in a loop is horribly inefficient. Every time you use ReDim Preserve, the entire memory area of the array is copied. Using a Collection is roughly 10 times faster (benchmarked with 100,000 inserts). A Scripting.Dictionary is slightly faster than a Collection, and makes it much easier to return a Variant containing an array (it has a .Keys method).

Excel specific

Calculating offsets and requesting Range objects from Excel is also expensive. You already have your If conditions set up to "short circuit VBA style", but each time you go through the loop you collect all of the Range's before you know whether you'll need them or not. For example, if this test fails you don't need to retrieve any of the others:

If Not closecell.Value = "?" Then

Since your offsets are all fixed (and you have a reference to the worksheet), you can skip some overhead by using direct cell addresses. For example, z.Offset(0, 1) can be replaced with ws.Cells(z.Row, 1). The only Range that you use for anything other than its value is z.

So... you should probably be pulling the .Value's into variables instead of the Range's. For example, in this section of code it's possible to request pausecell.Value 3 times.

If Not pausecell.Value = "" Then
    If CDate(pausecell.Value) >= this.FromDate Then
        '...
    ElseIf CDate(pausecell.Value) < this.FromDate And CDate(unpausecell.Value) >= this.FromDate Then
        '...
    End If

Each one of those is basically a function call that is going to return the exact same result.

Miscellania

The variable postcell is always the same as z (and has a much better name). I'd just use it as the loop variable.

You aren't checking for invalid casts anywhere. One simple way to check this is with the IsDate function. It's generally a good idea to treat a Worksheet as user input - no telling what is going to be in a cell.

EDIT:

A couple of things that I noticed in the additional code that was posted for the class:

AddToReport method

You can exit your loop that checks for existing worksheet names early if you find a match:

For i = 1 To Worksheets.Count
    If Worksheets(i).Name = sheetname Then
        exists = True
        Exit For
     End If
Next I

Using .Range to access rows (and concatenating the index) is unnecessary - you can use .Rows and just provide your index directly:

.Range(newrow & ":" & newrow).Value = ws.Range(array_rows(z) & ":" & array_rows(z)).Value
'...can become...
.Rows(newrow).Value = ws.Rows(array_rows(z)).Value

This is a bit more efficient and much more readable.

The test If z <= UBound(array_rows) Then is unnecessary because your loop counter is already bound by that condition and the UBound can't change inside the loop. It can be omitted entirely.

With blocks should be outside of loops unless the object they are referring to can change. Remember, each With keyword is at least one dereference.

The value for newrow is repeatedly calculating the last row of the Worksheet. You only need to do this once - afterward you can simply increment it:

With ThisWorkbook.Worksheets(sheetname)
    newrow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    For z = 1 To UBound(array_row)  '1 based index due to bug in DateRange()
        .Rows(newrow).Value = ws.Rows(array_rows(z)).Value
        newrow = newrow + 1
    Next
End With

AdvancedFilters method

I would consider a method with 6 state flag variables to be a candidate for creating a new class to hold that state. It would be much cleaner (and more in line with SRP) to simply extract this functionality into a ReportFilter class that is responsible for Worksheet filtering. It could probably use a more descriptive name as well - if the only thing I knew about the method was its name, I'd be pretty surprised when it started deleting rows.

More Miscellania

I'm a bit up in the air about storing member variables in a user type - it seems like a bit of overkill. When they have the same names as properties and are assigned to a variable named this, I'm not in the air any more. When your member variables are accessed in the properties, it looks like a stack overflow at first glance because this implies (at least to me) an instance of the class:

Public Property Let RequisitionNumber(ByVal inputValue As String)
    this.RequisitionNumber = inputValue
End Property

A class can be thought of as a structure with additional functionality, but I wouldn't take that literally. I find it much more simple and more readable to just create independent backing variables to use:

Private mRequisitionNumber As String

Public Property Let RequisitionNumber(ByVal inputValue As String)
    mRequisitionNumber = inputValue
End Property

That saves the next person who sees the code from doing the mental gymnastics of trying to remember that this.RequisitionNumber and Me.RequisitionNumber are 2 entirely different things.

That said, if you like the UDT, I'd at very least name it something else (like maybe backingVariables or privateMembers). C# programmers will be grateful.