D
Deleted member 140080
Guest
I am using Access 2003 (go ahead and laugh). This original code was was posted by KeithG back in 2007, and we have been using it. But for some reason this code does not work for some months, specifically, July 2015 and Sept 2014.
To fix I changed the following line to make it work for Sept 2014:
For lngCount = 0 To DateDiff("d", dteStart, dteEnd) 'Changed "For lngCount = 0" (used to be 1)- 9/9/14
I left it this way until July 2015, when I had to change it back to:
For lngCount = 1 To DateDiff("d", dteStart, dteEnd)
It worked until Sept 2015, now I need to change back to "0" again.
Here is the code that was posted in 2007 by KeithG:
____________________________________________________________
Public Function BusinessDays(dteStartDate As Date, dteEndDate As Date) As Long
Dim lngYear As Long
Dim lngEYear As Long
Dim dteStart As Date, dteEnd As Date
Dim dteCurr As Date
Dim lngDay As Long
Dim lngDiff As Long
Dim lngACount As Long
Dim dteLoop As Variant
Dim blnHol As Boolean
Dim dteHoliday() As Date
Dim lngCount As Long, lngTotal As Long
Dim lngThanks As Long
dteStart = dteStartDate
dteEnd = dteEndDate
lngYear = DatePart("yyyy", dteStart)
lngEYear = DatePart("yyyy", dteEnd)
If lngYear <> lngEYear Then
lngDiff = (((lngEYear - lngYear) + 1) * 7) - 1
ReDim dteHoliday(lngDiff)
Else
ReDim dteHoliday(6)
End If
lngACount = -1
For lngCount = lngYear To lngEYear
lngACount = lngACount + 1
'July Fourth
dteHoliday(lngACount) = DateSerial(lngCount, 7, 4)
lngACount = lngACount + 1
'Christmas
dteHoliday(lngACount) = DateSerial(lngCount, 12, 25)
lngACount = lngACount + 1
'New Years
dteHoliday(lngACount) = DateSerial(lngCount, 1, 1)
lngACount = lngACount + 1
'Thanksgiving - 4th Thursday of November
lngDay = 1
lngThanks = 0
Do
If Weekday(DateSerial(lngCount, 11, lngDay)) = 5 Then
lngThanks = lngThanks + 1
End If
lngDay = lngDay + 1
Loop Until lngThanks = 4
dteHoliday(lngACount) = DateSerial(lngCount, 11, lngDay)
lngACount = lngACount + 1
'Memorial Day - Last Monday of May
lngDay = 31
Do
If Weekday(DateSerial(lngCount, 5, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 5, lngDay)
Else
lngDay = lngDay - 1
End If
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 5, 1)
lngACount = lngACount + 1
'Labor Day - First Monday of Septemeber
lngDay = 1
Do
If Weekday(DateSerial(lngCount, 9, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 9, lngDay)
Else
lngDay = lngDay + 1
End If
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 9, 1)
'MsgBox dteHoliday(5)
lngACount = lngACount + 1
'Easter
lngDay = (((255 - 11 * (lngCount Mod 19)) - 21) Mod 30) + 21
dteHoliday(lngACount) = DateSerial(lngCount, 3, 1) + lngDay + _
(lngDay > 48) + 6 - ((lngCount + lngCount \ 4 + _
lngDay + (lngDay > 48) + 1) Mod 7)
Next
For lngCount = 1 To DateDiff("d", dteStart, dteEnd)
dteCurr = (dteStart + lngCount)
If (Weekday(dteCurr) <> 1) And (Weekday(dteCurr) <> 7) Then
blnHol = False
For dteLoop = 0 To UBound(dteHoliday)
'MsgBox dteHoliday(dteLoop) & " " & dteLoop
If (dteHoliday(dteLoop) = dteCurr) Then
blnHol = True
End If
Next dteLoop
If blnHol = False Then
lngTotal = lngTotal + 1
'MsgBox dteCurr
End If
End If
Next lngCount
BusinessDays = lngTotal
End Function
_________________________________________________________________
Here is my code:
________________________________________________________________
Public Function BusinessDays(dteStartDate As Date, dteEndDate As Date) As Long
Dim lngYear As Long
Dim lngEYear As Long
Dim dteStart As Date, dteEnd As Date
Dim dteCurr As Date
Dim lngDay As Long
Dim lngDiff As Long
Dim lngACount As Long
Dim dteLoop As Variant
Dim blnHol As Boolean
Dim dteHoliday() As Date
Dim lngCount As Long, lngTotal As Long
Dim lngThanks As Long
' dteStartDate and dteEndDate is coming from qryBusinessDayPercent WorkDays(month start date and today)and WorkdayYear (fiscal start date and today)
dteStart = dteStartDate
dteEnd = dteEndDate
lngYear = DatePart("yyyy", dteStart)
lngEYear = DatePart("yyyy", dteEnd)
If lngYear <> lngEYear Then
lngDiff = (((lngEYear - lngYear) + 1) * 7) - 1
ReDim dteHoliday(lngDiff)
Else
ReDim dteHoliday(6)
End If
lngACount = -1
For lngCount = lngYear To lngEYear
lngACount = lngACount + 1
'July Fourth lngACount= 0
dteHoliday(lngACount) = DateSerial(lngCount, 7, 4)
lngACount = lngACount + 1
'Christmas lngACount= 1
dteHoliday(lngACount) = DateSerial(lngCount, 12, 25)
lngACount = lngACount + 1
'New Years lngACount= 2
dteHoliday(lngACount) = DateSerial(lngCount, 1, 1)
lngACount = lngACount + 1
'Thanksgiving - 4th Thursday of November lngACount= 3
lngDay = 1
lngThanks = 0
Do
If Weekday(DateSerial(lngCount, 11, lngDay)) = 5 Then
lngThanks = lngThanks + 1
End If
lngDay = lngDay + 1
Loop Until lngThanks = 4
dteHoliday(lngACount) = DateSerial(lngCount, 11, lngDay)
lngACount = lngACount + 1
'Memorial Day - Last Monday of May lngACount= 4
lngDay = 31
Do
If Weekday(DateSerial(lngCount, 5, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 5, lngDay)
Else
lngDay = lngDay - 1
End If 'should this be after loop?
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 5, 1)
lngACount = lngACount + 1
'Labor Day - First Monday of September lngACount= 5
lngDay = 1
Do
If Weekday(DateSerial(lngCount, 9, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 9, lngDay)
Else
lngDay = lngDay + 1
End If
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 9, 1)
'MsgBox dteHoliday(5)
lngACount = lngACount + 1
'Easter lngACount= 6
lngDay = (((255 - 11 * (lngCount Mod 19)) - 21) Mod 30) + 21
dteHoliday(lngACount) = DateSerial(lngCount, 3, 1) + lngDay + _
(lngDay > 48) + 6 - ((lngCount + lngCount \ 4 + _
lngDay + (lngDay > 48) + 1) Mod 7)
Next
For lngCount = 0 To DateDiff("d", dteStart, dteEnd) 'original text = For lngCount = 1 To DateDiff("d", dteStart, dteEnd),
dteCurr = (dteStart + lngCount)
If (Weekday(dteCurr) <> 1) And (Weekday(dteCurr) <> 7) Then
blnHol = False
For dteLoop = 0 To UBound(dteHoliday)
'MsgBox dteHoliday(dteLoop) & " " & dteLoop
If (dteHoliday(dteLoop) = dteCurr) Then
blnHol = True
End If
Next dteLoop
If blnHol = False Then
lngTotal = lngTotal + 1
'MsgBox dteCurr
End If
End If
Next lngCount
BusinessDays = lngTotal
End Function
_________________________________________________________
Thanks in advance.
:banghead:
To fix I changed the following line to make it work for Sept 2014:
For lngCount = 0 To DateDiff("d", dteStart, dteEnd) 'Changed "For lngCount = 0" (used to be 1)- 9/9/14
I left it this way until July 2015, when I had to change it back to:
For lngCount = 1 To DateDiff("d", dteStart, dteEnd)
It worked until Sept 2015, now I need to change back to "0" again.
Here is the code that was posted in 2007 by KeithG:
____________________________________________________________
Public Function BusinessDays(dteStartDate As Date, dteEndDate As Date) As Long
Dim lngYear As Long
Dim lngEYear As Long
Dim dteStart As Date, dteEnd As Date
Dim dteCurr As Date
Dim lngDay As Long
Dim lngDiff As Long
Dim lngACount As Long
Dim dteLoop As Variant
Dim blnHol As Boolean
Dim dteHoliday() As Date
Dim lngCount As Long, lngTotal As Long
Dim lngThanks As Long
dteStart = dteStartDate
dteEnd = dteEndDate
lngYear = DatePart("yyyy", dteStart)
lngEYear = DatePart("yyyy", dteEnd)
If lngYear <> lngEYear Then
lngDiff = (((lngEYear - lngYear) + 1) * 7) - 1
ReDim dteHoliday(lngDiff)
Else
ReDim dteHoliday(6)
End If
lngACount = -1
For lngCount = lngYear To lngEYear
lngACount = lngACount + 1
'July Fourth
dteHoliday(lngACount) = DateSerial(lngCount, 7, 4)
lngACount = lngACount + 1
'Christmas
dteHoliday(lngACount) = DateSerial(lngCount, 12, 25)
lngACount = lngACount + 1
'New Years
dteHoliday(lngACount) = DateSerial(lngCount, 1, 1)
lngACount = lngACount + 1
'Thanksgiving - 4th Thursday of November
lngDay = 1
lngThanks = 0
Do
If Weekday(DateSerial(lngCount, 11, lngDay)) = 5 Then
lngThanks = lngThanks + 1
End If
lngDay = lngDay + 1
Loop Until lngThanks = 4
dteHoliday(lngACount) = DateSerial(lngCount, 11, lngDay)
lngACount = lngACount + 1
'Memorial Day - Last Monday of May
lngDay = 31
Do
If Weekday(DateSerial(lngCount, 5, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 5, lngDay)
Else
lngDay = lngDay - 1
End If
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 5, 1)
lngACount = lngACount + 1
'Labor Day - First Monday of Septemeber
lngDay = 1
Do
If Weekday(DateSerial(lngCount, 9, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 9, lngDay)
Else
lngDay = lngDay + 1
End If
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 9, 1)
'MsgBox dteHoliday(5)
lngACount = lngACount + 1
'Easter
lngDay = (((255 - 11 * (lngCount Mod 19)) - 21) Mod 30) + 21
dteHoliday(lngACount) = DateSerial(lngCount, 3, 1) + lngDay + _
(lngDay > 48) + 6 - ((lngCount + lngCount \ 4 + _
lngDay + (lngDay > 48) + 1) Mod 7)
Next
For lngCount = 1 To DateDiff("d", dteStart, dteEnd)
dteCurr = (dteStart + lngCount)
If (Weekday(dteCurr) <> 1) And (Weekday(dteCurr) <> 7) Then
blnHol = False
For dteLoop = 0 To UBound(dteHoliday)
'MsgBox dteHoliday(dteLoop) & " " & dteLoop
If (dteHoliday(dteLoop) = dteCurr) Then
blnHol = True
End If
Next dteLoop
If blnHol = False Then
lngTotal = lngTotal + 1
'MsgBox dteCurr
End If
End If
Next lngCount
BusinessDays = lngTotal
End Function
_________________________________________________________________
Here is my code:
________________________________________________________________
Public Function BusinessDays(dteStartDate As Date, dteEndDate As Date) As Long
Dim lngYear As Long
Dim lngEYear As Long
Dim dteStart As Date, dteEnd As Date
Dim dteCurr As Date
Dim lngDay As Long
Dim lngDiff As Long
Dim lngACount As Long
Dim dteLoop As Variant
Dim blnHol As Boolean
Dim dteHoliday() As Date
Dim lngCount As Long, lngTotal As Long
Dim lngThanks As Long
' dteStartDate and dteEndDate is coming from qryBusinessDayPercent WorkDays(month start date and today)and WorkdayYear (fiscal start date and today)
dteStart = dteStartDate
dteEnd = dteEndDate
lngYear = DatePart("yyyy", dteStart)
lngEYear = DatePart("yyyy", dteEnd)
If lngYear <> lngEYear Then
lngDiff = (((lngEYear - lngYear) + 1) * 7) - 1
ReDim dteHoliday(lngDiff)
Else
ReDim dteHoliday(6)
End If
lngACount = -1
For lngCount = lngYear To lngEYear
lngACount = lngACount + 1
'July Fourth lngACount= 0
dteHoliday(lngACount) = DateSerial(lngCount, 7, 4)
lngACount = lngACount + 1
'Christmas lngACount= 1
dteHoliday(lngACount) = DateSerial(lngCount, 12, 25)
lngACount = lngACount + 1
'New Years lngACount= 2
dteHoliday(lngACount) = DateSerial(lngCount, 1, 1)
lngACount = lngACount + 1
'Thanksgiving - 4th Thursday of November lngACount= 3
lngDay = 1
lngThanks = 0
Do
If Weekday(DateSerial(lngCount, 11, lngDay)) = 5 Then
lngThanks = lngThanks + 1
End If
lngDay = lngDay + 1
Loop Until lngThanks = 4
dteHoliday(lngACount) = DateSerial(lngCount, 11, lngDay)
lngACount = lngACount + 1
'Memorial Day - Last Monday of May lngACount= 4
lngDay = 31
Do
If Weekday(DateSerial(lngCount, 5, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 5, lngDay)
Else
lngDay = lngDay - 1
End If 'should this be after loop?
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 5, 1)
lngACount = lngACount + 1
'Labor Day - First Monday of September lngACount= 5
lngDay = 1
Do
If Weekday(DateSerial(lngCount, 9, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 9, lngDay)
Else
lngDay = lngDay + 1
End If
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 9, 1)
'MsgBox dteHoliday(5)
lngACount = lngACount + 1
'Easter lngACount= 6
lngDay = (((255 - 11 * (lngCount Mod 19)) - 21) Mod 30) + 21
dteHoliday(lngACount) = DateSerial(lngCount, 3, 1) + lngDay + _
(lngDay > 48) + 6 - ((lngCount + lngCount \ 4 + _
lngDay + (lngDay > 48) + 1) Mod 7)
Next
For lngCount = 0 To DateDiff("d", dteStart, dteEnd) 'original text = For lngCount = 1 To DateDiff("d", dteStart, dteEnd),
dteCurr = (dteStart + lngCount)
If (Weekday(dteCurr) <> 1) And (Weekday(dteCurr) <> 7) Then
blnHol = False
For dteLoop = 0 To UBound(dteHoliday)
'MsgBox dteHoliday(dteLoop) & " " & dteLoop
If (dteHoliday(dteLoop) = dteCurr) Then
blnHol = True
End If
Next dteLoop
If blnHol = False Then
lngTotal = lngTotal + 1
'MsgBox dteCurr
End If
End If
Next lngCount
BusinessDays = lngTotal
End Function
_________________________________________________________
Thanks in advance.
:banghead: