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 ????

## All 12 Replies

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))

Remainder = Day(MyDateString) Mod 7

MyWeek = Day(MyDateString) \ 7

If Remainder > 0 Then MyWeek = MyWeek + 1

MsgBox MyWeek``````

Good Luck

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

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))
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.

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

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))
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

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.

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``````

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.

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.

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. 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``````

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

how can i use your function kwilson7770?

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, learning, and sharing knowledge.