pswilliams0
Registered User.
- Local time
- , 19:34
- Joined
- Apr 19, 2012
- Messages
- 20
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
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