Problem with Week Numbers between dates on New Year

Question

Problem

The following [mcve] will output an array of arrays of week numbers between two dates. It works when both dates are on the same year, however, some years have 52 weeks and start within the last days of the last year. And others have 53 weeks.

An example of 52 weeks is the 2020 calendar:

Where the first week begins on Dec 30.

And the example of 53 weeks is the 2016 calendar:

That begins only on Jan 4th.

Code

The following code is commented and outputs an array of arrays with the week numbers.

Sub w_test()
    Dim Arr() As Variant, ArrDateW() As Variant
    'Initial Date
    DateI = DateSerial(2015, 5, 5)
    'Final Date
    DateF = DateSerial(2017, 9, 20)
    'Difference in weeks between DateI and DateF
    weekDif = DateDiff("ww", DateI, DateF) + k - 1

    i = Weekday(DateI)
    d = DateI

    'If not Sunday, go back to last week, to start the loop
    If i <> 1 Then
        d = DateAdd("d", -(i - 1), d)
    End If

    ReDim ArrDateW(weekDif)
    ReDim Arr(2)
    'Loop on all weeks between two dates to populate array of arrays
    For i = 0 To weekDif
        'Date
        Arr(0) = d
        'Trying to solve problem with New Year
        If Application.WorksheetFunction.WeekNum(d) = 53 Then
            flag = True
        End If
        If flag = False Then
            Arr(1) = Application.WorksheetFunction.WeekNum(d)
        Else
            Arr(1) = Application.WorksheetFunction.WeekNum(DateSerial(Year(d) + 1, 1, 1))
            flag = False
        End If

        'Year
        Arr(2) = Year(d)
        'Populate array of arrays
        ArrDateW(i) = Arr
        'Next Week Number
        d = DateAdd("ww", 1, d)
    Next i

    'To stop with Ctrl+F8
    Debug.Print d
End Sub

Question

2015 had 53 weeks, however the program outputs the following:

And between 2016 and 2017, the output is a mess:

How to fix the program to output these week numbers correctly?

Did you try using a conditional initialization of the arrDateW(33)(2) = 53 if the year is 2015? Can this be done with this variable? — Karlomanio
I want to make it dynamic, to work on every year, like also on 2020. It's been days that I am stuck on it... And can't think properly, so i asked a question to receive feedbacks or answers. — danieltakeshi
The way I see it you can a) automate it by year, making conditional language to initialize that variable- that is changing the value of the variable in your loop by year OR b) use another logic other than "weeks in a year." — Karlomanio
No matter how you put it, 365[.25] days is never going to divide nicely into groups of 7 days. Retailers have solved this problem over a century ago by splitting the year in 4 quarters of 13 weeks each (3-4-3 weeks per month, respectively), and adding a 53rd week every couple of years; that way weekly sales are always comparable year-over-year. Week 53 simply compares to week 1 when present; consider having a "calendar" table that holds metadata for each date (DayOfWeek, WeekOfYear, WeekOfMonth, MonthOfYear, MonthOfQuarter, etc.) - you'll then be able to time-aggregate & compare anything. — Mathieu Guindon

PeterT PeterT · Accepted Answer · 2019-07-08T18:41:02

I went about it somewhat differently, relying on built-in VBA functions to correctly calculate the week numbers. Read about ISO week numbers is this answer and see how I'm using the DataPart function -- though you can substitute your own version of Ron de Bruin's ISO week number function if you feel it's warranted.

A couple of quick side notes:

Always use Option Explicit
Try to use more descriptive variable names. YOU know what you're talking about NOW. In a few months, you'll struggle to remember what d and Arr mean (even if it seems obvious now). It's just a good habit and makes the code self-documenting.
My example below breaks the logic into a separate function with an optional parameter (just for fun) that would allow the caller to change the start of the week to a different day.

Code module:

Option Explicit

Sub w_test()
    Dim initialDate As Date
    Dim finaldate As Date
    initialDate = #5/5/2015#
    finaldate = #9/29/2017#

    Dim weeks As Variant
    weeks = WeekNumbers(initialDate, finaldate)

    Debug.Print "There are " & UBound(weeks, 1) & " weeks between " & _
                Format(initialDate, "dd-mmm-yyyy") & " and " & _
                Format(finaldate, "dd-mmm-yyyy")
End Sub

Private Function WeekNumbers(ByVal initialDate As Date, _
                             ByVal finaldate As Date, _
                             Optional ByVal weekStart As VbDayOfWeek = vbSunday) As Variant
    Dim numberOfWeeks As Long
    numberOfWeeks = DateDiff("ww", initialDate, finaldate, weekStart, vbFirstFullWeek)

    Dim startOfWeek As Date
    If Weekday(initialDate) <> vbSunday Then
        Dim adjustBy As Long
        If Weekday(initialDate) > weekStart Then
            adjustBy = Weekday(initialDate) - weekStart
        Else
            adjustBy = (Weekday(initialDate) + 7) - weekStart
        End If
        startOfWeek = DateAdd("d", -adjustBy, initialDate)
    End If

    Dim allTheWeeks As Variant
    ReDim allTheWeeks(1 To numberOfWeeks)

    Dim weekInfo As Variant
    ReDim weekInfo(1 To 3)

    Dim i As Long
    For i = 1 To numberOfWeeks
        weekInfo(1) = startOfWeek
        weekInfo(2) = DatePart("ww", startOfWeek, weekStart, vbFirstFourDays)
        weekInfo(3) = Year(startOfWeek)
        allTheWeeks(i) = weekInfo
        startOfWeek = DateAdd("ww", 1, startOfWeek)
    Next i

    WeekNumbers = allTheWeeks
End Function