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

Find Date in Range

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
rangedatefind

Problem

I have a spreadsheet where I control my shift hours. In such spreadsheet I input the date, the start time, time left for lunch, time back to work, end time and sometimes the overtime.

After that I have created a couple of functions to calculate the amount of time worked, the difference against the 8-hour shift expected time, bank of hours and so forth.

Everything is working fine, but I'm not very happy with the performance of it and I suspect the reason is one of my functions, which checks whether the current date is a holiday or not.

This is my current function:

Function IsHoliday(cell As Date) As Boolean

    Dim item            As Range
    Dim holidayList     As Range

'    On Error Resume Next

    Set holidayList = Sheet2.Range("A3:A17")

    For Each item In holidayList

        If cell = item.Value Then
            IsHoliday = True
            Exit Function
        End If

    Next

    On Error GoTo 0

    IsHoliday = False

End Function


Sheet2 from the code is related to this spreadsheet:

The function is called in for each row in my Main Sheet, as highlighted in the picture below:

There are probably more issues in this, but I think the main issue is that I'm using a For Each loop to check if the date is a holiday in each row, but I sincerely don't know a faster way to do it. Can anyone share their thoughts on improvement points?

If you feel the need to check other functions and/or calculations in order to help me, just let me know.

Solution

Since this is a UDF that clearly will get called quite a bit, you're right to be concerned with performance. Your search code can run MUCH faster if you perform the search on a memory array. That, along with a few other items noted here, will improve your function:

  • Don't assume the workbook and worksheet. Your code is assuming it's running on the ActiveSheet when it doesn't have to be. So in your case, assign a couple variables to explicitly identify your execution environment. This guarantees far fewer headaches in the future.



  • Dynamically size the range of your holiday list. Your function will be more flexible when you need to add holidays to work next year.



  • Perform the search in a memory array. The biggest time consumer in your code is repeatedly having to read the data from a worksheet Cell in every loop each time the UDF is called. One single access to copy the data range to a memory array will drastically reduce your execution time.



  • I find it easier to set a default return value for the function before I enter into a loop or a long stretch of logic. Then I only worry about changing the default return value if the tests pass.



Hopefully these tips will speed up your function and improve your code.

Option Explicit
Function IsHoliday(cell As Date) As Boolean
    Dim wb As Workbook
    Dim holidaySH As Worksheet
    Set wb = ThisWorkbook
    Set holidaySH = wb.Sheets("Sheet2")

    Const FIRSTROW = 3
    Dim lastRow As Long
    Dim holidayList As Range
    lastRow = holidaySH.Cells(holidaySH.Rows.Count, "A").End(xlUp).Row
    Set holidayList = holidaySH.Range("A" & FIRSTROW).Resize(lastRow - FIRSTROW, 1)

    Dim holidays As Variant
    holidays = holidayList

    Dim i As Long
    IsHoliday = False          'default return condition
    For i = 0 To UBound(holidays)
        If holidays(i) = cell.value Then
            IsHoliday = True
            Exit For
        End If
    Next i
End Function



EDIT: the code below should be quicker, in response to the suggestion from @MatsMug to use a static Dictionary.

Option Explicit
Public Function IsHoliday(cell As Range, _
                          Optional forceReload as boolean = False) As Boolean
    '--- establish a static dictionary to populate once, then
    '    reuse with each call
    Const DATE_FORMAT = "mm/dd/yyyy"
    Static holidays As Scripting.Dictionary
    If (holidays Is Nothing) or forceReload Then
        Dim wb As Workbook
        Dim holidaySH As Worksheet
        Set wb = ThisWorkbook
        Set holidaySH = wb.Sheets("Sheet2")

        Const FIRSTROW = 3
        Dim lastRow As Long
        Dim holidayList As Range
        lastRow = holidaySH.Cells(holidaySH.Rows.Count, "A").End(xlUp).Row
        Set holidayList = holidaySH.Range("A" & FIRSTROW).Resize(lastRow - FIRSTROW, 1)

        Set holidays = New Scripting.Dictionary
        Dim i As Long
        For i = 1 To (lastRow - FIRSTROW)
            '--- the date (as a string) is the Key,
            '    the description as the Item
            holidays.Add Format(holidayList.Cells(i, 1), DATE_FORMAT), _
                         holidayList.Cells(i, 2)
        Next i
    End If

    IsHoliday = False
    If holidays.Exists(Format(cell.value, DATE_FORMAT)) Then
        IsHoliday = True
    End If
End Function

Code Snippets

Option Explicit
Function IsHoliday(cell As Date) As Boolean
    Dim wb As Workbook
    Dim holidaySH As Worksheet
    Set wb = ThisWorkbook
    Set holidaySH = wb.Sheets("Sheet2")

    Const FIRSTROW = 3
    Dim lastRow As Long
    Dim holidayList As Range
    lastRow = holidaySH.Cells(holidaySH.Rows.Count, "A").End(xlUp).Row
    Set holidayList = holidaySH.Range("A" & FIRSTROW).Resize(lastRow - FIRSTROW, 1)

    Dim holidays As Variant
    holidays = holidayList

    Dim i As Long
    IsHoliday = False          'default return condition
    For i = 0 To UBound(holidays)
        If holidays(i) = cell.value Then
            IsHoliday = True
            Exit For
        End If
    Next i
End Function
Option Explicit
Public Function IsHoliday(cell As Range, _
                          Optional forceReload as boolean = False) As Boolean
    '--- establish a static dictionary to populate once, then
    '    reuse with each call
    Const DATE_FORMAT = "mm/dd/yyyy"
    Static holidays As Scripting.Dictionary
    If (holidays Is Nothing) or forceReload Then
        Dim wb As Workbook
        Dim holidaySH As Worksheet
        Set wb = ThisWorkbook
        Set holidaySH = wb.Sheets("Sheet2")

        Const FIRSTROW = 3
        Dim lastRow As Long
        Dim holidayList As Range
        lastRow = holidaySH.Cells(holidaySH.Rows.Count, "A").End(xlUp).Row
        Set holidayList = holidaySH.Range("A" & FIRSTROW).Resize(lastRow - FIRSTROW, 1)

        Set holidays = New Scripting.Dictionary
        Dim i As Long
        For i = 1 To (lastRow - FIRSTROW)
            '--- the date (as a string) is the Key,
            '    the description as the Item
            holidays.Add Format(holidayList.Cells(i, 1), DATE_FORMAT), _
                         holidayList.Cells(i, 2)
        Next i
    End If

    IsHoliday = False
    If holidays.Exists(Format(cell.value, DATE_FORMAT)) Then
        IsHoliday = True
    End If
End Function

Context

StackExchange Code Review Q#143467, answer score: 4

Revisions (0)

No revisions yet.