VBA optimization to increase backend speed

[pswilliams0]

Hi all,
I'm new to VBA and was recently tasked with a small internal project for my employer. I created a form that automatically calculates a number of dates from a date entered by the user. The tricky thing, is that the dates calculated are workdays only. This means, weekends and holidays have to be excluded. I have a piece of code working to accomplish this. However, I split the database to implement the multi-user environment and when I beta tested it, the communication was REALLY slow. This appears to be a common problem. I've included the code below. It reads a query of Holidays from the table "Holidays" that the user enters. Then it loops through the number of days from the start date checking to see if it is a weekend or a holiday by matching it up with the query. Then I populate 4 other boxes on the form with that data.

I'm hoping to optimize the code. If you can offer any potential fixes with some VBA to guide me, I'd be really appreciative!!! Thanks!

ps. I did try to create the list of holidays as a Variant and that did speed up the process by about 3 seconds. So, I'm now at 13 seconds for the calculation. I'm hoping to get it down to 2-4 seconds at most...
_________________
__________________


___________________________________________________
Private Function IsWeekDay(Day As Date) As Boolean
Dim WeekNumber As Integer

WeekNumber = Weekday(Day)

If WeekNumber = 1 Or WeekNumber = 7 Then
IsWeekDay = False
Else
IsWeekDay = True
End If
End Function
_______________________________________________________

Private Function IsHoliday(Day As Date) As Boolean
' create database and recordset objects
Dim db As DAO.Database
Dim rs As DAO.Recordset

IsHoliday = False

' set database object to current database
Set db = CurrentDb
' set recordset object to your query
Set rs = db.OpenRecordset("Holidays Query") ' collects data from desired query

Do While Not rs.EOF
If rs.Fields("Holiday") = Day Then
IsHoliday = True
Exit Do
Else

rs.MoveNext
End If
Loop

' close the recordset object (connection to the query)
rs.Close

' clear the defined objects
Set rs = Nothing
Set db = Nothing
End Function
_______________________________________________________

Private Function AddWorkDays(StartDate As Date, Days As Long) As Date

Dim TestDate As Date
TestDate = StartDate

Do While Days > 0
TestDate = DateAdd("w", 1, TestDate)
If IsWeekDay(TestDate) = True And IsHoliday(TestDate) = False Then
Days = Days - 1
Else
End If

Loop

AddWorkDays = TestDate ' tells loop what to return

End Function
___________________________________________________

Private Sub EN_Date_Exit(Cancel As Integer) 'populates other boxes on form

If EN_Date.Value <> 0 Or EN_Date.Value <> Null Then
' if a value is entered in text box on form
First_Draft_Due.Value = AddWorkDays(EN_Date.Value, 14)
Second_Draft_Due.Value = AddWorkDays(EN_Date.Value, 21)
Approver_Comments_Due.Value = AddWorkDays(EN_Date.Value, 28)
Final_Draft_Due.Value = AddWorkDays(EN_Date.Value, 30)
Else
End If

End Sub

 

[gemma-the-husky]

i expect the slowness is due to incrementing a loop, inside of which you havea test isholiday() repeatedly opening recordsets.

at the very least, i would preload the holiday dates into an array of some sort, so you only ever access those dates once.

----
maybe you could reconsider the isweekday() function as simply

isweekday = weekday(date) between vbmonday and vbfriday

----
the idea is to try and get the looping as efficient as possible.

for example in your main loop

THIS

First_Draft_Due.Value = AddWorkDays(EN_Date.Value, 14)
Second_Draft_Due.Value = AddWorkDays(EN_Date.Value, 21)
Approver_Comments_Due.Value = AddWorkDays(EN_Date.Value, 28)
Final_Draft_Due.Value = AddWorkDays(EN_Date.Value, 30)

could be rewrittten as this, which would save a lot of time

First_Draft_Due.Value = AddWorkDays(EN_Date.Value, 14)
Second_Draft_Due.Value = AddWorkDays(First_Draft_Due, 7)
Approver_Comments_Due.Value = AddWorkDays(Second_Draft_Due, 7
Final_Draft_Due.Value = AddWorkDays(Approver_Comments_Due, 2)

 

[VilaRestal]

And also

If IsWeekDay(TestDate) = True And IsHoliday(TestDate) = False Then

even if weekday is false it will still test for holiday. Expanding that into nested Ifs will reduce the number of holiday checks by 2/7ths.

Using an array in the IsHoliday function would be best but failing that the loop to find a record is unnecessary:

Private Function IsHoliday(Day As Date) As Boolean
    Dim rs As DAO.Recordset
    Set rs = db.OpenRecordset("SELECT Holiday FROM [Holidays Query] WHERE Holiday = #" & Day & "#", dbOpenSnapshot)
    IsHoliday = Not rs.BOF
    rs.Close
    Set rs = Nothing
End Function

Gets the Jet engine to do the work rather than VBA. Jet is a lot quicker at doing those things.

(But even
rs.FindFirst "Holiday = #" & Day & "#"
IsHoliday = Not rs.EOF
would be fasterthan what you have.)

 

[VilaRestal]

And

If EN_Date.Value <> 0 Or EN_Date.Value <> Null Then

should be

If Nz(EN_Date.Value,0) <> 0 Then

 

[pswilliams0]

i expect the slowness is due to incrementing a loop, inside of which you havea test isholiday() repeatedly opening recordsets.

at the very least, i would preload the holiday dates into an array of some sort, so you only ever access those dates once.

I have tried to look up how to do this and have had a significant amount of difficulty. Can you describe how I assign the data in the holiday table to an array and then reference the array in the loop? I'm confused how I structure that.

----
maybe you could reconsider the isweekday() function as simply

isweekday = weekday(date) between vbmonday and vbfriday

----

So, I gave this a try but it didn't like the "between" operator. Was that shorthand for something else? Sorry to be a newb.


In doing more research, I can't seem to find an answer to this question:
Is there a way I can load the date calculating module with the Holiday query array on the frontend so that it doesn't require as much network traffic?

Thanks,
Philip

 

[spikepl]

Check this : http://www.jpsoftwaretech.com/calculate-working-days-minus-holidays-in-vba/

Also I am curious: why are you checking IsWeekday at all? Since you are using DateAdd("w", 1, TestDate)

 

[pswilliams0]

Check this : http://www.jpsoftwaretech.com/calculate-working-days-minus-holidays-in-vba/

Also I am curious: why are you checking IsWeekday at all? Since you are using DateAdd("w", 1, TestDate)

The calculated dates don't check the weekend without it. This is my first experience coding, so I can't tell you why. I tried it without the "IsWeekday" function and the code sped up significantly, but the dates calculated were wrong. (i.e. the weekends were not excluded...) If you have an idea how I can incorporate that into the "DateAdd" operator, please let me know!

 

[spikepl]

It seems "w" doesn't give what one would expect (thanlks for that info).. I googled a bit, and it is not at all clear what that thing gives. For older version of Access MS admitted that it does NOT give workdays. http://support.microsoft.com/kb/115489

Here is another link btw: http://access.mvps.org/access/datetime/date0012.htm

Ultimately, you are using a brute-force approach by scanning all days. In fact you know that a week has 5 working days, and 2 nonworking days. Doing integer division of time inetrval with 7 would give you number of weeks (and hence weekend days to add/deduct) . Then a check remains for if any were holidays etc. Depending on how much this function bugs you, it could be worthwhile to make a more intelligent algorithm.

 

[RainLover]

Have a Captain Cook at the attached sample.

It may be of some help.

 

[gemma-the-husky]

It seems "w" doesn't give what one would expect (thanlks for that info).. I googled a bit, and it is not at all clear what that thing gives. For older version of Access MS admitted that it does NOT give workdays. http://support.microsoft.com/kb/115489

Here is another link btw: http://access.mvps.org/access/datetime/date0012.htm

Ultimately, you are using a brute-force approach by scanning all days. In fact you know that a week has 5 working days, and 2 nonworking days. Doing integer division of time inetrval with 7 would give you number of weeks (and hence weekend days to add/deduct) . Then a check remains for if any were holidays etc. Depending on how much this function bugs you, it could be worthwhile to make a more intelligent algorithm.

I don't thing you can just count days, divide by 7, and reliably eliminate weekends with that method. I suspect you may get a different answer with 52 days, starting on a Friday, compared with 52 days starting on a monday.

you might be able to find an efficient algorithm to do this, but bruteforce won't take long. It's simple numeric checking. Only a handful of clock ticks, surely. The slow bit would be the isholiday() test - especially if it needed a dlookup - so the key must be to get the holiday days into an array.


code to find a workday "targetdays" workdays hence from startdate somethnig like this.

checkdate = startdate
x=0
while x<targetdays
   checkdate=checkdate+1
[COLOR=red]   if not isholiday(checkdate) then[/COLOR]
          if weekday(checkdate) between vbmonday and vbfriday then
               x = x+1
          end if
     end if
wend
finishdate = checkdate

 

[spikepl]

I don't thing you can count days, divide by 7, and reliably eliminsate weekends. I suspect you may get a different answer with 52 days, starting on a Friday, compared with 52 days starting on a monday.

Correct. It just requires some thinking and adjsutments - all doable.

Another brute-force approach is to store dates of all workingdays in a table, and provide a key - simply a day counter form the beginning. A date 20 workdays later from starting date will be simply given by the index of the starting date + 20. Two lookups and that's it.

 

[piperfyc]

Correct. It just requires some thinking and adjsutments - all doable.

Another brute-force approach is to store dates of all workingdays in a table, and provide a key - simply a day counter form the beginning. A date 20 workdays later from starting date will be simply given by the index of the starting date + 20. Two lookups and that's it.

It just requires some thinking and adjsutments - all doable.

 

[Pat Hartman]

Here's some code I've been using for years. It is not mine. I think you will find that it returns the answer in sub-zero seconds. The reason of course is that it doesn't use any code loops. Even just implementing the Holiday part of the code will save you a lot of time.

Function BusinessDays(StartDate As Date, EndDate As Date) As Integer

'By Susan Sales Harkins and Doris Manning
'Inside Microsoft Access Feb 2004
' http://download.elementkjournals.com/access/200402/busdays.zip

Dim intHolidays As Integer
Dim intTotalDays As Integer
Dim intWeekendDays As Integer
'Dim rst As New ADODB.Recordset
Dim rst As DAO.Recordset
Dim strSQL As String
    Select Case DatePart("w", StartDate, vbMonday)  'Week starts on monday
        Case 6
            StartDate = DateAdd("d", StartDate, 2)  'Saturday
        Case 7
            StartDate = DateAdd("d", StartDate, 1)  'Sunday
    End Select
    Select Case DatePart("w", EndDate, vbMonday)    'Week starts on monday
        Case 6
            EndDate = DateAdd("d", EndDate, -1)     'Saturday
        Case 7
            EndDate = DateAdd("d", EndDate, -2)     'Sunday
    End Select
    strSQL = "Select Count(*) as HolidayCount From tblHolidays " & _
            "Where HolidayDate BETWEEN #" & StartDate & "#" & _
            " AND " & "#" & EndDate & "#;"
    'rst.Open strSQL, CurrentProject.Connection
    Set rst = CurrentDb.OpenRecordset(strSQL)
    intHolidays = rst!HolidayCount                                      'Count Holidays between dates
    intTotalDays = DateDiff("d", StartDate, EndDate) + 1                'Calc dif in days
    intWeekendDays = DateDiff("ww", StartDate, EndDate, vbMonday) * 2   'Calc dif in weeks and multiply by 2
    BusinessDays = intTotalDays - intWeekendDays - intHolidays
    Set rst = Nothing

End Function