Put weeknum in an array? - excel

Question

Here is what im trying to do: Cell B2: Start Date and Cell B3: End Date
Example:
B2 --> 01/01/2019
B3 --> 01/03/2019
I would like to get all the week numbers and put them in an array
Here is a picture of the Excel cells
Here is my code so far
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim StartD As Date, EndD As Date
Set wks = ThisWorkbook.Sheets("Foglio1")
Worksheets("Foglio1").Range("D2:XZ39").Clear
StartD = Worksheets("Foglio1").Cells(2, 2)
EndD = Worksheets("Foglio1").Cells(3, 2)
I would like to loop though the given two dates: 01/01/2019 , 01/03/2019 get the week numbers and put them in an array(if it's possible)
So my output would be:
Array(1, 2, 3, 4, 5, 6, 7, 8, 9) --> Since between January and March there are 9 weeks

Answer 1

If you do not want Calendar Weeks and want to include a week even if there is one day from it then you can try this.
Logic
It finds when the next week is starting. So default number of weeks is 1.
Loops and counts the number of days (Say Monday and then Tuesday and so on) between two dates and whichever is highest, it returns it and adds it to 1.
Also there is no need to loop and create an array. You can create a sequential array in One Go
Code
Option Explicit
Sub Sample()
Dim WeeksCount As Long
Dim CurCount As Long
Dim countOfWeeks As Long
Dim i As Long, tmpCount As Long
Dim sDate As Date, eDate As Date
sDate = DateSerial(2019, 1, 6)
eDate = DateSerial(2019, 1, 8)
If Weekday(sDate, vbMonday) <> 1 Then
sDate = DateAdd("d", 7 - Weekday(sDate, vbMonday) + 1, sDate)
WeeksCount = 1
End If
For i = 1 To 7
CurCount = GetMeMyKindOfWeeksTotal(sDate, eDate, i)
If tmpCount < CurCount Then tmpCount = CurCount
Next i
WeeksCount = WeeksCount + tmpCount
Dim MyArray
MyArray = Evaluate("Row(1" & ":" & WeeksCount & ")")
If WeeksCount = 1 Then
Debug.Print MyArray(1)
Else
For i = LBound(MyArray) To UBound(MyArray)
Debug.Print MyArray(i, 1)
Next i
End If
End Sub
Private Function GetMeMyKindOfWeeksTotal(ByVal sDate As Date, ByVal eDate As Date, dy As Long)
Dim j As Long
Dim TotalDays As Long
For j = sDate To eDate
If Weekday(j) = dy Then
TotalDays = TotalDays + 1
End If
Next
GetMeMyKindOfWeeksTotal = TotalDays
End Function
Various Tests
sDate = DateSerial(2019, 1, 6)
eDate = DateSerial(2019, 1, 8)
This will give you 2
sDate = DateSerial(2019, 1, 1)
eDate = DateSerial(2019, 3, 1)
This will give you 9
sDate = DateSerial(2019, 1, 1)
eDate = DateSerial(2019, 1, 1)
This will give you 1
sDate = DateSerial(2019, 1, 1)
eDate = DateSerial(2019, 1, 8)
This will give you 2

Answer 2

You could use something like the following
Option Explicit
Sub Sample()
Dim sDate As Date, eDate As Date
Dim NoOfWeeks As Long
Dim arr As Variant
Dim i As Long
With Worksheets("Foglio1")
sDate = .Range("B2")
If Weekday(sDate, vbMonday) <> 1 Then
sDate = DateAdd("d", 7 - Weekday(sDate, vbMonday) + 1, sDate)
NoOfWeeks = 1
End If
eDate = .Range("B3")
End With
If sDate = eDate Then
NoOfWeeks = NoOfWeeks + 1
Else
NoOfWeeks = NoOfWeeks + WorksheetFunction.RoundUp((eDate - sDate) / 7, 0)
End If
ReDim arr(1 To NoOfWeeks)
For i = 1 To NoOfWeeks
arr(i) = i
Next i
MsgBox Join(arr, ";")
End Sub

Answer 3

You can define a UDF like below:
Public Function GetWeekNums(startDate As Date, endDate As Date, Optional varDelim As Variant)
Dim lngStartWeek As Long
Dim lngEndWeek As Long
Dim i As Long
If IsMissing(varDelim) Then varDelim = ","
lngStartWeek = Application.WorksheetFunction.WeekNum(startDate)
lngEndWeek = Application.WorksheetFunction.WeekNum(endDate)
For i = lngStartWeek To lngEndWeek
GetWeekNums = GetWeekNums & " " & i
Next
GetWeekNums = Replace(Trim(GetWeekNums), " ", varDelim & " ")
End Function
and then use it in workbook like:
=GetWeekNums(B2,B3,";")

Answer 4

If someone prefers just a worksheet formula, you can use:
=ROW(INDEX($A:$A,WEEKNUM($B$2),1):INDEX($A:$A,WEEKNUM($B$3),1))
Depending on when your week starts, use the appropriate return_type argument for the function.