HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Determining whether a date is within a range

Submitted by: @import:stackexchange-codereview··
0
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.

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 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
ToD

Solution

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 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 i

Code Snippets

ReDim arr_validRows(0) As Variant
ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
arr_validRows(UBound(arr_validRows)) = z.row
If Not closecell.Value = "?" Then
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
For i = 1 To Worksheets.Count
    If Worksheets(i).Name = sheetname Then
        exists = True
        Exit For
     End If
Next I

Context

StackExchange Code Review Q#136552, answer score: 5

Revisions (0)

No revisions yet.