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(H2ドル:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"
 .Range("R5").Value = "=MEDIAN(H2ドル:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"
 .Range("R6").Value = "=STDEVP(H2ドル:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"
 .Range("R7").Value = "=VARP(H2ドル: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.

• Brad Johansen: When you wrote the comment:For z = 1 To UBound(array_row) '1 based index due to bug in DateRange() is this a comment that z is indexed at 1 instead of 0 because array_row(0) is empty (the whole ReDim mess). Also what do you mean by "short circuit VBA style?"
• Comintern: @RollTideBrad - For the first question, yes. For the second question, VBA always evaluates every condition in an If statement. Most? other languages will stop evaluating as soon as they hit a condition that makes it impossible not to take one branch. I.e., if VBA short circuited you could safely do If IsDate(foo) And CDate(foo) > Now Then. Without short circuiting you can't, because it will still try to cast foo if it can't be cast to a Date -- it doesn't just branch when IsDate(foo) is false.
• Brad Johansen: Okay, thank you. Both of those answers explain some of the early problems I had. The empty array_row(0) was a byproduct of multiple attempts of getting that section of AddToReport() to work. I played until it started working.
• Comintern: @RollTideBrad - Usually I've seen people add an "array initialized flag" that gets checked before expanding it. In this case another container would be the way I'd go.