How to get Current Week Number of the Month

[Ravi Kant]

Hello !
I want to get the current week number of the month. I have used this code below : -

Private Sub Command1_Click()
Dim t_Day As Double
t_Day = Day(DTPicker1.Value)
Select Case t_Day
Case 1, 2, 3, 4, 5, 6, 7, 8
Text1.Text = "1st Week"
Case 9, 10, 11, 12, 13, 14, 15, 16
Text1.Text = "2nd Week"
Case 17, 18, 19, 20, 21, 22, 23, 24
Text1.Text = "3rd Week"
Case 25, 26, 27, 28, 29
Text1.Text = "4th Week"
Case 30, 31
Text1.Text = "5th Week"
End Select
End Sub

This does not return always true result. Any better code for this ????

[vb5prgrmr]

First off, your code does not take into account if the month starts on a saturday or any other day other than what is considered to be the first day of the week. Second, in a month with 31 days there could actually be 6 weeks in the month depending upon what day the month started and this would depend upon if you are using a fixed week or a dynamic week.

Fixed week means you consider the week to be set from sun to sat or mon to sun while a dynamic week means that the week starts on the first day of the month.

For a dynamic week it is quit simple

Dim Remainder As Integer, Week As Integer

Remainder = Day("5/15/2009") Mod 7

Week = Day("5/15/2009") \ 7

If Remainder > 0 Then Week = Week + 1

MsgBox Week

However, if you are using fixed weeks then...

Dim Remainder As Integer, MyWeek As Integer
Dim DayStart As Integer, MyDateString As String

MyDateString = "5/13/2009"

DayStart = Weekday(Month(MyDateString) & "/1/" & Year(MyDateString))

MyDateString = DateAdd("d", DayStart, MyDateString)

Remainder = Day(MyDateString) Mod 7

MyWeek = Day(MyDateString) \ 7

If Remainder > 0 Then MyWeek = MyWeek + 1

MsgBox MyWeek

Good Luck

[Ravi Kant]

Thanks vb5prgrmr
But still my problem is not solved. I have DtPicker control in my form and i want the result according to it's value. I try you code giving date as dtpicker value but still problem is same.

Private Sub Command1_Click()

Dim Remainder As Integer, Week As Integer
Remainder = Day(DTPicker1.Value) Mod 7
Week = Day(DTPicker1.Value) \ 7
If Remainder > 0 Then Week = Week + 1
MsgBox Week
End Sub

Your second Code :

Private Sub Command2_Click()

Dim Remainder As Integer, MyWeek As Integer
Dim DayStart As Integer, MyDateString As String
MyDateString = DTPicker1.Value
DayStart = Weekday(Month(MyDateString) & "/1/" & Year(MyDateString))
MyDateString = DateAdd("d", DayStart, MyDateString)
Remainder = Day(MyDateString) Mod 7
MyWeek = Day(MyDateString) \ 7
If Remainder > 0 Then MyWeek = MyWeek + 1
MsgBox MyWeek

End Sub

But both these code does not give always correct result.

[vb5prgrmr]

Thanks vb5prgrmr But still my problem is not solved. I have DtPicker control in my form and i want the result according to it's value. I try you code giving date as dtpicker value but still problem is same.

Private Sub Command1_Click()

Dim Remainder As Integer, Week As Integer Remainder = Day(DTPicker1.Value) Mod 7 Week = Day(DTPicker1.Value) \ 7 If Remainder > 0 Then Week = Week + 1 MsgBox Week End Sub

Your second Code :

Private Sub Command2_Click()

Dim Remainder As Integer, MyWeek As Integer Dim DayStart As Integer, MyDateString As String MyDateString = DTPicker1.Value DayStart = Weekday(Month(MyDateString) & "/1/" & Year(MyDateString)) MyDateString = DateAdd("d", DayStart, MyDateString) Remainder = Day(MyDateString) Mod 7 MyWeek = Day(MyDateString) \ 7 If Remainder > 0 Then MyWeek = MyWeek + 1 MsgBox MyWeek

End Sub

But both these code does not give always correct result.

Yep, the second has an error because of a quick cut and paste. Just remove the "If Remainder" line

[hkdani]

You could use the MonthView Control.

The Week Property of that control returns that particular day's week number in relation to the current year.

For example

Dim intWeek as integer

intWeek = MonthView1.week

intWeek should return the week number for the particular day selected in the MonthView Control.

You'll probably have to extra coding to figure out which week it is in relation to the month, though.

[hkdani]

This should work. Might want to clean it up a bit and check the validity and logic of the Select Case Statement. It has some errors. I'll leave that to you to find. But something like the following:

Option Explicit
Dim dFirstDayMonth As Date, intMonth As Integer, strMonthDayOne As String
    Dim intFirstSaturday As Integer, intFirstDay As Integer
    Dim strDayOne As String, intPickedDay As Integer

Private Sub cmdFindWeek_Click()
    Dim intPickedDay As Integer
    Dim intMonthWeek As Integer
    intPickedDay = DTPicker1.Day
    intMonth = DTPicker1.Month
    strMonthDayOne = CStr(intMonth) & "/1"
    dFirstDayMonth = CDate(strMonthDayOne)
    intFirstDay = Day(dFirstDayMonth)
    ' First Saturday should always be the following:
    intFirstSaturday = 8 - intFirstDay
    intMonthWeek = FindWeek(intPickedDay)
    
    Text1 = "This is week " & CStr(intMonthWeek)
End Sub

Private Function FindWeek(CurrentDay As Integer) As Integer
Dim intFirstDayWeekTwo As Integer
intFirstDayWeekTwo = intFirstSaturday + 1
Select Case CurrentDay

Case 1 To intFirstSaturday
    FindWeek = 1
Case intFirstDayWeekTwo To intFirstDayWeekTwo + 6
    FindWeek = 2
Case intFirstDayWeekTwo  + 7 To intFirstDayWeekTwo + 12
    FindWeek = 3
Case intFirstDayWeekTwo + 14 To intFirstDayWeekTwo + 18
    FindWeek = 4
Case intFirstDayWeekTwo + 21 To intFirstDayWeekTwo + 24
    FindWeek = 5
Case intFirstDayWeekTwo + 28 To intFirstDayWeekTwo + 30
    FindWeek = 6
End Select

End Function

[Ravi Kant]

Thanks hkdani !
But still it has problem . As for example for 5 january 2009 it is week 2 but it returns week 1 . Please check it.

[hkdani]

But still it has problem . As for example for 5 january 2009 it is week 2 but it returns week 1 . Please check it.

I'm leaving that up to you. I thought it was right, but testing it I did see a few bugs. I think it's a logic error on my part, but then again I also thought maybe the control itself wasn't working right. But I really doubt the control is giving the problem, it's probably me.

[Ravi Kant]

Please help ! I am new in VB.

[hkdani]

Okay. The problem is in the Select Case CurrentDay , ..... End Select section.

As someone nicely pointed out in a previous post, you could have a possibility of 6 weeks in a month, if Day 1 fell on a Saturday (maybe even a Friday with 31 days?). That's why there are 6 cases: Case 1, Case 2, Case 3, ...., Case 6.

You simply have to determine that your tests in each of the 6 cases make sense.

Case 1 should always be from 1 to intFirstSaturday.
If you'll look at the code

' First Saturday should always be the following:
    intFirstSaturday = 8 - intFirstDay

You should be able to find the actual day for the First Saturday of the month with that formula. The Day() fundtion returns which day of the week a certain day happens to fall on: Sunday, Monday, Tuesday, Wednesday, etc. So, if Day(#3/1/2009#) returns a value of 1, then 8 - 1 = 7: March 7, is Saturday, in other words.

That's the first test for Case 1

Case 2 should start with the Day after the first Saturday or intFirstSaturday + 1 or as in the above code: IntFirstDayWeekTwo.

We're testing from Sunday to Saturday or a period of 7 days. So

Case (intFirstDayWeekTwo) to (intFirstDayWeekTwo + 6 )

Ah, I think I see the error. It begins in Case 3. I think I should be adding 7 instead of 6. So that should be + 13 instead of 12?, 20 instead of 18, etc.

That may give you enough to go on.

[kwilson7770]

This can return the week number for a date in the month or it can return how many weeks are in that month

Public Function FindWeekNumber(ByVal TheDate As Date, ByVal ReturnWeekCount As Boolean, ByVal ReturnWeekNumber As Boolean) As String
        'Works for every month of 2010. All Tested
        'Tested random dates in the years 2000,2001,2002,2003,2004,2005,2006,2007,2008,2009
        'and they all worked. So I created an algorithm :)
        Dim DayCount = 0
        Select Case TheDate.Month
            Case 1 : DayCount = 31 ' Jan
            Case 2 ' Feb
                If IsDate("2/29/" & TheDate.Year) Then : DayCount = 29
                Else : DayCount = 28
                End If
            Case 3 : DayCount = 31 ' Mar
            Case 4 : DayCount = 30 ' Apr
            Case 5 : DayCount = 31 ' May
            Case 6 : DayCount = 30 ' Jun
            Case 7 : DayCount = 31 ' Jul
            Case 8 : DayCount = 31 ' Aug
            Case 9 : DayCount = 30 ' Sep
            Case 10 : DayCount = 31 ' Oct
            Case 11 : DayCount = 30 ' Nov
            Case 12 : DayCount = 31 'Dec
        End Select
        Dim TempDate As Date
        Dim num = 0
        Do
            num += 1
            TempDate = TheDate.Month & "/" & num & "/" & TheDate.Year
        Loop Until TempDate.DayOfWeek = System.DayOfWeek.Sunday
        'Num is the first Sunday of the month (day wise)
        Dim WeekCount
        If num <> 1 Then : WeekCount = 2
        Else : WeekCount = 1
        End If
        Dim WeekNumber = 1
        Do While num + 7 <= DayCount
            num += 7
            If TheDate.Day + 7 >= num And TheDate.Day <= num Then WeekNumber = WeekCount
            WeekCount += 1
        Loop
        If ReturnWeekNumber = True And ReturnWeekCount = True Then MsgBox("You can't return both numbers at once!" & vbNewLine & "Choose only one to return", MsgBoxStyle.Exclamation, "FindWeekNumber(Date, True, True) Error")
        If ReturnWeekCount = True Then Return WeekCount
        If ReturnWeekNumber = True Then Return WeekNumber
        Return ""
    End Function

[volann0]

u're so cool kwilson7770 !!
its works ^^