CODEWITHSUNDEEP
excelweek-numbervba
Chandrasekar R
Chandrasekar R

Reputation: 123

VBA for week number of a month similar to desktop calendar

Please could you assist me to add Week number for particular months?

This the vba:

With Target
If .Column <> 10 Or .Row < 1 Then Exit Sub
If .Value = "Select" Then
    If .Offset(0, 1).Value = "" Then
        .Offset(0, 1).NumberFormat = "mm/dd/yy"
        .Offset(0, 1).Value = Now - 1      
    End If

My definition of week number is based on full weeks being Sunday through to Saturday:

  1. If the first of the month does not start on a Sunday then any days up to the first Saturday of the month will be Week 1

  2. The next sets of Sunday through Saturday will be Week 2, Week 3, Week 4 etc. Unless the month started on a Sunday in which case the sets will be Week 1, Week 2, Week 3 etc.

  3. If the month does not end on a Saturday, then the Sunday through to till the end of the month will be Week N+1 where N is the last full week given by step 2.

For example: this month, the 1st of March is on Wednesday. So March 1st-4th (Wed-Sat) will be 1 week and so on.

Upvotes: 1

Views: 1797

Answers (2)

Robin Mackenzie
Robin Mackenzie

Reputation: 19299

You can try and see if the WeekNum function suits your purpose.

You can use it in your code like this:

.Offset(0, 2).Value = WorksheetFunction.WeekNum(Now - 1)

The documentation says:

Returns the week number of a specific date. For example, the week containing January 1 is the first week of the year, and is numbered week 1.

There are two systems used for this function:

System 1 The week containing January 1 is the first week of the year, and is numbered week 1.

System 2 The week containing the first Thursday of the year is the first week of the year, and is numbered as week 1. This system is the methodology specified in ISO 8601, which is commonly known as the European week numbering system.

Edit

OP definition of week is per a desktop calendar where each green block is a week - so March 2017 has 5 weeks. Note January 2016 has six weeks under this system!

enter image description here

Therefore, the WeekNum formula will not give the expected result. Instead the following function can be used:

Function GetCalendarTypeMonthWeek(dt As Date) As String

    Dim lngDayOfMonth As Long
    Dim lngWeekDay As Long
    Dim dtFirstDayOfMonth As Date
    Dim lngFactor As Long

    lngDayOfMonth = Day(dt)
    lngWeekDay = Weekday(dt, vbSunday) '<~~ Sunday=1, Monday=2, etc
    
    'does month start on Sunday?
    dtFirstDayOfMonth = DateValue("01-" & Month(dt) & "-" & Year(dt))
    If Weekday(dtFirstDayOfMonth, vbSunday) = 1 Then
        lngFactor = 1
    Else
        lngFactor = 2
    End If
    
    'get calendar week number for date
    GetCalendarTypeMonthWeek = "Week " & CStr(Int((lngDayOfMonth - lngWeekDay) / 7) + lngFactor)

End Function

To be used in the sample code like:

.Offset(0, 2).Value = GetMonthWeek(Now - 1)

Upvotes: 1

Pspl
Pspl

Reputation: 1474

I think the next function will return the value you want:

Function WeekOfTheMonth(DateRef As Date) As Integer
    Dim WeekFirstDayRefMonth As Integer
    WeekFirstDayRefMonth = Application.WeekNum(DateSerial(Year(DateRef), Month(DateRef), 1), 2)
    Dim WeekLastDayRefMonthB As Integer        
    WeekLastDayRefMonthB = Application.WeekNum(DateSerial(Year(DateRef), Month(DateRef), 1) - 1, 2)
    Select Case WeekFirstDayRefMonth - WeekLastDayRefMonthB
        Case 0: WeekOfTheMonth = Application.WeekNum(DateRef, 2) - WeekLastDayRefMonthB + 1
        Case 1: WeekOfTheMonth = Application.WeekNum(DateRef, 2) - WeekLastDayRefMonthB
        Case Else: WeekOfTheMonth = Application.WeekNum(DateRef, 2)
    End Select
End Function

Just write WeekOfTheMonth("place your date here") on your code and you're good to go. Please note: I didn't check all the scenarios for this code so please let me know if you're getting unexpected results.

Upvotes: 1

Related Questions