We help IT Professionals succeed at work.

# First Monday of week

on
Medium Priority
969 Views
Hi guys; I'm in a bit o a pickle here:

Basically I have a form that I want the label for each of the 60 labels I have on the form to have the caption to be set to the date for the Monday of that week in the month.  The form consists of 60 labels 5 across by 12 down.  If the label does not have a week (e.g. the 5th of the five across) then set that caption to a blank string.  he code I am using is as follows:

Dim YearStart As Date
Dim YearEnd As Date
Dim CurWeek As Date
Dim CurMth As String
Dim FirstDayMth As Date
Dim LastDayMth As Date
Dim CurLbl As String

YearStart = DLookup("[AYStart]", "[dbo_T011_ApplicationVariables]")
YearEnd = DLookup("[AYEnd]", "[dbo_T011_ApplicationVariables]")
CurWeek = YearStart
CurMth = Mid(Format(CurWeek, "Medium Date"), 4, 3)

For I = 1 To 4
For x = 1 To DateDiff("ww", FirstDayMth, LastDayMth)
CurLbl = "lbl" & Mid(Format(CurWeek, "Medium Date"), 4, 3) & x
If Mid(Format(CurWeek - Weekday(CurWeek) + 2, "Medium Date"), 4, 3) = CurMth Then
Debug.Print CurLbl & " - " & CurWeek + IIf(Weekday(CurWeek) = 1, 1, 9 - (Weekday(CurWeek) Mod 8)) & " - " & CurWeek
Me(CurLbl).Caption = CurWeek - Weekday(CurWeek) + 2
Else
Me(CurLbl).Caption = ""
End If
CurMth = Mid(Format(CurWeek, "Medium Date"), 4, 3)
Next x
Next I
End Sub
Oh, and the year starts on Aug 01 (academic year) so August is the first row.

Trouble is, it isnt working well.  Basically, August looks OK, but Sept starts to go wrong, gets to the 4th column (label) OK, but the 5th is untouched, then for October starts on the 27th Oct????? for the 1st column, then the 2nd column seems OK, eg. 6th Oct......but basically I can't work out the logic.

Any help greatly appreciated.  Sorry for the poor explanation.
Comment
Watch Question

## View Solution Only

Commented:
Can you please advise the label names startting with top left as I suspect the problem lies with this logic.
Cheers, Andrew

Commented:
For any given date d the first Monday of the month containing that date is given by:

FirstMonday = d-day(d)-Weekday(d-day(d))+9

The next Monday:

SecondMonday = d-day(d)-Weekday(d-day(d))+9+7

ThirdMonday = d-day(d)-Weekday(d-day(d))+9+7+7

FourthMonday=d-day(d)-Weekday(d-day(d))+9+7+7+7

FifthMonday=d-day(d)-Weekday(d-day(d))+9+7+7+7+7

If the month of the FifthMonday does not equal the month of the FirstMonday then the Caption is null.  Only on the fifth Monday you need to test.
=IIF(Month(d-day(d)-Weekday(d-day(d))+9)=Month(d-day(d)-Weekday(d-day(d))+9+7+7+7+7), d-day(d)-Weekday(d-day(d))+9+7+7+7+7,Null)
Look OK?

Commented:
I included the sums to give you an idea of my approach - to appreciate the logic ;-)
Top Expert 2008

Commented:
the problem is on this command:

since the last week of August is/can be the first week of September. In your code, CurWeek is incremented by 1 week after the last week of August. So at the start of September, CurWeek is already the 2nd week of September. And this will again happend on September to October so the difference will only get larger.

Commented:
Can you not just have the weeeks name Week01 to Week12?
Cheers, Andrew
Top Expert 2008
Commented:
try this
``````Dim YearStart As Date
Dim YearEnd As Date
Dim CurWeek As Date
Dim CurMth As String
Dim FirstDayMth As Date
Dim LastDayMth As Date
Dim CurLbl As String
Dim SharedRow as boolean

YearStart = DLookup("[AYStart]", "[dbo_T011_ApplicationVariables]")
YearEnd = DLookup("[AYEnd]", "[dbo_T011_ApplicationVariables]")
CurWeek = YearStart
CurMth = Mid(Format(CurWeek, "Medium Date"), 4, 3)

For I = 1 To 4
For x = 1 To DateDiff("ww", FirstDayMth, LastDayMth)
CurLbl = "lbl" & Mid(Format(CurWeek, "Medium Date"), 4, 3) & x
If Mid(Format(CurWeek - Weekday(CurWeek) + 2, "Medium Date"), 4, 3) = CurMth Then
Debug.Print CurLbl & " - " & CurWeek + IIf(Weekday(CurWeek) = 1, 1, 9 - (Weekday(CurWeek) Mod 8)) & " - " & CurWeek
Me(CurLbl).Caption = CurWeek - Weekday(CurWeek) + 2
sharedrow=false
Else
Me(CurLbl).Caption = ""
sharedrow=true
End If
CurMth = Mid(Format(CurWeek, "Medium Date"), 4, 3)
Next x
if sharedrow then
end if
Next I
End Sub
``````

Commented:
I guess you weren't interested in my logic, but here's where it could take you.  This assumes 12 rows with 5 labels per row titled - lbl & mmm & j+1
``````Private Sub Form_Load()
Dim i As Integer, j As Integer, yrStart, mName As String, lblName As String
Dim FMonInAug As Date, MonDate As Date, blankCtr As Integer
yrStart = DateSerial(IIf(Month(Date) < 8, Year(Date) - 1, Year(Date)), 8, 1)
FMonInAug = yrStart - Weekday(yrStart) + 9
For i = 0 To 11
mName = MonthName(IIf((8 + i) Mod 12 = 0, 12, (8 + i) Mod 12), True)
For j = 0 To 4
lblName = "lbl" & mName & j + 1
MonDate = DateAdd("ww", i * 5 + j + blankCtr, FMonInAug)
If mName = Format(MonDate, "mmm") Then
Me.Controls(lblName).Caption = MonDate
Else
Me.Controls(lblName).Caption = ""
blankCtr = blankCtr - 1
End If
Next j
Next i
End Sub
``````