Functions Error Counting # of Thursday

[VSolano]

Hi all
I am new to Access/VBA and I have this issue which I have not been able to figure out.

I am building this function to count the number of Thursday between two days base on the pay frequency(1 Weekly, 2 Biweekly, 3 Monthly). The start date and ending date is not fix. Each employee could have different start and end date.

The function works fine when I am testing on the module. From January to December I expect 52/26/12 according to the pay frequency, but when I use in a query it does not give me any value for 2017. I got #Error. if I use start and day on 2016 it does works.

Option Compare Database
Option Explicit
Public Function CountNODays(Optional STDate As Date, Optional EndDate As Date, Optional PRFrq As Integer) As Integer
Dim ICount As Integer
Dim STDateNO As Integer
'STDate = #12/1/2017#
EndDate = #12/31/2017#
STDate = STDate + (8 - Weekday(STDate, vbThursday))
'PRFrq = 1
STDateNO = Weekday(STDate)

'If STDateNO = 5 Then
' 'looping up to thursday and then use this date as pay date
'
'Else
' STDate = CDate(STDate)
' Do Until STDateNO = 5
' STDate = DateAdd("d", 1, STDate)
' STDateNO = STDateNO + 1
'
' Loop
'
'
'
'End If

STDate = CDate(STDate)

ICount = 0
'Selecting the pay frequency to calculate the weeks
Select Case PRFrq
Case 1
Do While STDate <= EndDate

STDate = DateAdd("d", 7, STDate)
ICount = ICount + 1

Loop
CountNODays = ICount

Case 2
Do While STDate <= EndDate

STDate = DateAdd("d", 14, STDate)
ICount = ICount + 1

Loop
CountNODays = ICount
Case 3
Do While STDate <= EndDate

STDate = DateAdd("m", 1, STDate)

ICount = ICount + 1

Loop
CountNODays = ICount

End Select
CountNODays = ICount

End Function

 

[The_Doc_Man]

Aw, gosh, you are working too hard! SIMPLIFY! Take advantage of knowing how calendars work as periodic entities.

First, decide which day starts the test period. Keep that. Using Weekday() it will be one of seven numbers, Sunday = 1, Thursday = 5, Saturday = 7. No problem there.

Second, use the same method to decide which day ends the test period. Keep that weekday number too.

Third, convert BOTH dates to LONG (integers) and subtract them as LONGs to get a LONG result. (Don't worry, the day parts of date variables will convert safely to fit into a LONG.) This difference is the number of days between the dates. Now integer-divide the difference by 7 to keep the result as a LONG. Hold this number, it is part of your answer.

Fourth, if 5 (the number for Thursday) is greater than or equal to your starting weekday AND less than or equal to your ending weekday, add 1 to that third number you got with subtraction and division.

That is the number of Thursdays in question, with no loops. Might take a few lines of DIM statements to assure you have the variables you need and maybe four or five lines of code for the computation, tops.

 

[VSolano]

I was using part of your idea but I got in trouble when the date falls after Thursday

 

[JHB]

Your function seems to run okay without errors for 2017 - try the attachment.

 

[VSolano]

I am confused. It looks that the function does not works when the start date falls after Thursday. My concern is how can I tell the function that I am counting Thursday. I tested September 2017 and I am getting 5 instead of 4

Private Function CountThrs() As Integer
Dim STDate As Date
Dim EndDate As Date
Dim StDate2 As Integer
Dim EndDate2 As Integer
Dim LGStDate As Long
Dim LGEndDate As Long
Dim StMenusEnd As Long

STDate = #8/1/2017#
EndDate = #8/31/2017#

StDate2 = Weekday(STDate)
Debug.Print StDate2
EndDate2 = Weekday(EndDate)
LGStDate = CLng(STDate)
LGEndDate = CLng(EndDate)
StMenusEnd = LGEndDate - LGStDate
StMenusEnd = StMenusEnd / 7
If StDate2 >= 5 Or EndDate2 <= 5 Then
StMenusEnd = StMenusEnd + 1
Else

End If
Debug.Print StMenusEnd
End Function

 

[MarkK]

Following The_Doc_Man's excellent instructions...

Function CountWeekday(d1 As Date, d2 As Date, Optional DayOfWeek As VbDayOfWeek = vbSunday) As Long
    Dim days As Long
    Dim extra As Boolean
    
    days = CLng(d2) - CLng(d1)
    extra = Weekday(d1) <= DayOfWeek And Weekday(d2) >= DayOfWeek
    CountWeekday = days / 7 - extra
End Function

I think that does it, but I haven't tested it extensively.

 

[The_Doc_Man]

There are two errors in my original "shot from the hip."

The first has to do with the fact that dates should be INCLUSIVE. That is, the dates to be considered are in the [d1 to d2] interval, not the [d1 to d2) interval, if I recall that particular notation correctly. Simple subtraction gives the wrong answer because you are subtracting a one-based number from another one-based number and you subtract too many "ones" in that case, so to get the correct inclusive interval you have to add back one of them.

The second error is that this gives the wrong number when the month begins on a Thursday, Friday, or Saturday because the inclusions aren't quite so simple.

Function CountWeekday(d1 As Date, d2 As Date, Optional DayOfWeek As VbDayOfWeek = vbSunday) As Long

    Dim days As Long
    Dim extra As Boolean
    Dim wd1 As Long
    Dim wd2 As Long
        
    days = CLng(d2) - CLng(d1) + 1                        'dates are INCLUSIVELY counted
    wd1 = Weekday(d1)
    wd2 = Weekday(d2)
    If wd1 < wd2 Then                                     'see which way fragment lies
        extra = (wd1 <= DayOfWeek) And (wd2 >= DayOfWeek) 'see if target is between the days
    Else
        extra = (DayOfWeek >= wd1) Or (DayOfWeek <= wd2)  'see if target is OUTSIDE the days
    End If
        
    CountWeekday = days / 7 - extra
    
End Function

In English, count the whole weeks. If the weeks come out even, you are done. If not, see if the fractional week included the day in question. That's why you come up with 5 instead of 4. In my original description, I failed to allow for the fact that even for non-leap-year February, if it starts on Sunday (day 1) and ends on Saturday (day 7), the "extra" test would be true and would add one days improperly.

I have tested this code for every day of the week for the months of February, March, and April of 2017 and it now gives the right answer for each case.

 

[VSolano]

Thanks for all your help

I was testing this code and it failed on June. It should be 5 and I get 4

 

[VSolano]

Your function seems to run okay without errors for 2017 - try the attachment.

it does not work with my numbers

 

[JHB]

it does not work with my numbers

Okay, then show your numbers/dates and the result you want for each.

 

[The_Doc_Man]

I was testing this code and it failed on June. It should be 5 and I get 4

Using the code as shown in post #7 of this thread, I ran a test of all seven days of the week. It works correctly for June, 2017, which begins on a Thursday and ends on a Friday. Here is a cut-paste of my test.

debug.Print countweekday( #1-jun-2017#,#30-jun-2017#,vbSunday)
 4 
debug.Print countweekday( #1-jun-2017#,#30-jun-2017#,vbmonday)
 4 
debug.Print countweekday( #1-jun-2017#,#30-jun-2017#,vbtuesday)
 4 
debug.Print countweekday( #1-jun-2017#,#30-jun-2017#,vbwednesday)
 4 
debug.Print countweekday( #1-jun-2017#,#30-jun-2017#,vbthursday)
 5 
debug.Print countweekday( #1-jun-2017#,#30-jun-2017#,vbfriday)
 5 
debug.Print countweekday( #1-jun-2017#,#30-jun-2017#,vbsaturday)
 4

If it doesn't work for you, go back and check whether you are using the code from post #7 or from an earlier post.

 

[MarkK]

I get errors with the code in post #7 also. Counting Thursdays from 4/1 to 4/1, for example, I get 1, but should get 0. Counting Thursdays from 4/1 to 4/6 I should get 1, but I get 2. Here's a little test harness to run a procedure through a series of days...

Private Sub Test192874612348148()
[COLOR="Green"]'   tests the [COLOR="Blue"]CountWeekday[/COLOR] function for multiple days in a loop[/COLOR]
    Const MONTH As Integer = 4
    Const START_DAY As Integer = 1
    Const DOW As Integer = vbThursday
    Dim i As Integer
    
    Debug.Print "Month of " & MonthName(MONTH) & " " & Year(Date) & "  starting on: " & START_DAY
    Debug.Print " to...", WeekdayName(DOW) & "s"
    Debug.Print "========", "========"
    For i = 1 To 30
        Debug.Print i, [COLOR="Blue"]CountWeekday[/COLOR](DateSerial(2017, MONTH, START_DAY), DateSerial(2017, MONTH, i), DOW)
    Next
End Sub

If I use the following routine to count weekdays I get--so far--correct results...

Private Function CountWeekday(ByVal d1 As Date, ByVal d2 As Date, Optional DayOfWeek As VbDayOfWeek = vbSunday) As Long
    Dim days As Long
    Dim wd1 As Long
    Dim wd2 As Long
    Dim extra As Boolean
    
    days = CLng(d2) - CLng(d1)
    wd1 = Weekday(d1)
    wd2 = Weekday(d2)
    If wd1 < wd2 Then
        extra = wd1 <= DayOfWeek And DayOfWeek <= wd2
    ElseIf wd1 > wd2 Then
        extra = wd1 <= DayOfWeek Or DayOfWeek <= wd2
    Else
        extra = wd1 = DayOfWeek And DayOfWeek = wd2
    End If
    
    CountWeekday = Fix(days / 7) - extra
End Function

...but I had hoped to find a simpler way that did not use that messy If...ElseIf...Else...End IF block.

 

[MarkK]

This is a little bit of a leaner version...

Function CountWeekday(ByVal d1 As Date, ByVal d2 As Date, Optional dow As VbDayOfWeek = 1) As Long
    Dim wd1 As Long
    Dim wd2 As Long
    Dim extra As Boolean
    
    wd1 = Weekday(d1)
    wd2 = Weekday(d2)
    If wd1 <= wd2 Then
        extra = wd1 <= dow And dow <= wd2
    Else
        extra = wd1 <= dow Or dow <= wd2
    End If
    CountWeekday = Fix((CLng(d2) - CLng(d1)) / 7) - extra
End Function

 

[The_Doc_Man]

thanks for your additions, Mark! This one turned out to have an extra wrinkle or two. However, I'm still bothered by the idea that the implied "BETWEEN" is inclusive, but because days are not zero-based, the math gets fouled up. Your solution doesn't include a direct recognition of that fact. Darned non-leap-year February anyway!

 

[MarkK]

You bet Doc_Man! I found this problem harder than I expected. I still wish I could find a fully calculable solution and not rely on the If block, but...
Cheers,