patternMinor
Determining whether a date is within a range
Viewed 0 times
determiningrangedatewithinwhether
Problem
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.
Below is the full class module that this function is contained in. The
Class: Report_Generator
```
Option Explicit
Private Type Reports
RequisitionNumber As String
FromDate As Date
ToD
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.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 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 FunctionBelow 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
ToD
Solution
DateRange() function
Array handling
You have a bug. The first element of
...but when you add items to the array, you increase the bound before you add the new item:
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
Still on the topic of arrays, resizing arrays in a loop is horribly inefficient. Every time you use
Excel specific
Calculating offsets and requesting
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,
So... you should probably be pulling the
Each one of those is basically a function call that is going to return the exact same result.
Miscellania
The variable
You aren't checking for invalid casts anywhere. One simple way to check this is with the
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:
Using
This is a bit more efficient and much more readable.
The test
With blocks should be outside of loops unless the object they are referring to can change. Remember, each
The value for
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
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
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.rowThis 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 = "?" ThenSince 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 Then
'...
End IfEach 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 IUsing
.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)).ValueThis 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 WithAdvancedFilters 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 iCode Snippets
ReDim arr_validRows(0) As VariantReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
arr_validRows(UBound(arr_validRows)) = z.rowIf Not closecell.Value = "?" ThenIf 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 IfFor i = 1 To Worksheets.Count
If Worksheets(i).Name = sheetname Then
exists = True
Exit For
End If
Next IContext
StackExchange Code Review Q#136552, answer score: 5
Revisions (0)
No revisions yet.