patternMinor
Find Date in Range
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:
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
If you feel the need to check other functions and/or calculations in order to help me, just let me know.
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 FunctionSheet2 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:
Hopefully these tips will speed up your function and improve your code.
EDIT: the code below should be quicker, in response to the suggestion from @MatsMug to use a static
- Don't assume the workbook and worksheet. Your code is assuming it's running on the
ActiveSheetwhen 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
Cellin 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 FunctionEDIT: 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 FunctionCode 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 FunctionOption 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 FunctionContext
StackExchange Code Review Q#143467, answer score: 4
Revisions (0)
No revisions yet.