ACCESS VBA: Error when converting ISO Week Number to Date Range

Question

I am trying to create a simple week selector based on the ISO Week number, which will give me the Monday date and the Sunday date every time the user clicks on "Current Week" or "Previous Week" or "Next Week" Buttons, as I will select all the transactions within those dates.

I have managed doing that following the steps from MS Access get ISO standard week number to get the correct week number for a specific date, and then converting the week number back to date following https://answers.microsoft.com/en-us/msoffice/forum/msoffice_access-mso_other/convert-week-number-to-date/3d0f8c90-a155-e011-8dfc-68b599b31bf5.

My conversion works fine for this year, every time I click in previous or next week, it brings the correct Monday and Sunday along with its correct week number, however, when it arrives on week 1 of 2021, which brings the correct dates of 04/01/2021 and 10/01/2021 (from and to respectively), the next click on "next week" brings the dates "from = 06/01/2021" and "to = 12/01/2021", and it stops going forward, the clicks don't change the dates.

When clicking "Previous Week", it goes well till week 1 of 2020, which brings the correct dates of 30/12/2019 and 05/01/2020, but the next click on "Previous Week" brings the dates 23/12/2018 and 29/12/18, but in this case, if I continue to click in Previous Week button it continues going back into 2018 correctly. It is just mad how it occurs.

I believe that the problem is in the DateSerial when converting the Week Number to Date Range, I have tried to figure it out, but I couldn't do it.

I hope you guys can help me out.

Thank you in advance.

'''' This is the function in a module to get the week number

Public Function ISOWeek(MyDate As Date) As Integer

    ISOWeek = Format(MyDate, "ww", vbMonday, vbFirstFourDays)
    
    If ISOWeek > 52 Then
    
        If Format(MyDate + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then ISOWeek = 1
        
    End If

End Function


'''' These subs run on the form code

Private Sub NextWeek_Click()

    Dim SelectedWeek As Date

    SelectedWeek = Me.Date_From.Value

    FirstDayWeek = DateAdd("ww", ISOWeek(SelectedWeek), DateSerial(Year(SelectedWeek), 1, 1) - 2)

    LastDayWeek = DateAdd("ww", ISOWeek(SelectedWeek), DateSerial(Year(SelectedWeek), 1, 1) + 4)

    Me.Date_From.Value = FirstDayWeek
    Me.Date_To.Value = LastDayWeek

End Sub

Private Sub PreviousWeek_Click()

    Dim SelectedWeek As Date

    SelectedWeek = Me.Date_From.Value
    
    FirstDayWeek = DateAdd("ww", ISOWeek(SelectedWeek) - 2, DateSerial(Year(SelectedWeek), 1, 1) - 2)

    LastDayWeek = DateAdd("ww", ISOWeek(SelectedWeek) - 2, DateSerial(Year(SelectedWeek), 1, 1) + 4)

    Me.Date_From.Value = FirstDayWeek
    Me.Date_To.Value = LastDayWeek

End Sub

Gustav Gustav · Accepted Answer · 2020-09-09T07:15:17

Leave the week numbers from the date calculations, they only complicate matters.

By using the generic functions listed below, your two functions can be reduced to:

Private Sub NextWeek_Click()

    Me.Date_From.Value = DateNextWeekPrimo(Me.Date_From.Value, vbMonday)
    Me.Date_To.Value = DateNextWeekUltimo(Me.Date_From.Value, vbMonday)

End Sub

Private Sub PreviousWeek_Click()

    Me.Date_From.Value = DatePreviousWeekPrimo(Me.Date_From.Value, vbMonday)
    Me.Date_To.Value = DatePreviousWeekUltimo(Me.Date_From.Value, vbMonday)

End Sub


' Returns the primo date of the week following the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateNextWeekPrimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
    
    Number = 1
    Interval = "ww"
    
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)
    
    ' Return first weekday with no time part.
    ResultDate = DateAdd("d", 1 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
    
    DateNextWeekPrimo = ResultDate
    
End Function


' Returns the ultimo date of the week following the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateNextWeekUltimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
    
    Number = 1
    Interval = "ww"
    
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)

    ' Return last weekday with no time part.
    ResultDate = DateAdd("d", 7 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
    
    DateNextWeekUltimo = ResultDate
    
End Function


' Returns the primo date of the week preceding the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatePreviousWeekPrimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
    
    Number = -1
    Interval = "ww"
    
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)
    
    ' Return first weekday with no time part.
    ResultDate = DateAdd("d", 1 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
    
    DatePreviousWeekPrimo = ResultDate
    
End Function


' Returns the ultimo date of the week preceding the week of the date passed.
'
' 2016-01-13. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatePreviousWeekUltimo( _
    ByVal DateThisWeek As Date, _
    Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbSunday) _
    As Date

    Dim Interval    As String
    Dim Number      As Double
    Dim ResultDate  As Date
    
    Number = -1
    Interval = "ww"
    
    ' Offset date.
    ResultDate = DateAdd(Interval, Number, DateThisWeek)

    ' Return last weekday with no time part.
    ResultDate = DateAdd("d", 7 - Weekday(ResultDate, FirstDayOfWeek), Fix(ResultDate))
    
    DatePreviousWeekUltimo = ResultDate
    
End Function

ACCESS VBA: Error when converting ISO Week Number to Date Range

1 Answers