asked on

First Monday of week

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:

Private Sub Form_Load()
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
FirstDayMth = DateSerial(year(DateAdd("m", I, YearStart)), month(DateAdd("m", I, YearStart)) - 1, 1)
LastDayMth = DateSerial(year(DateAdd("m", I, YearStart)), month(DateAdd("m", I, YearStart)), 0)
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
CurWeek = DateAdd("ww", 1, CurWeek)
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 isnt 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.

TextReport

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

GRayL

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?

GRayL

I included the sums to give you an idea of my approach - to appreciate the logic ;-)

ee_rlee

the problem is on this command:
CurWeek = DateAdd("ww", 1, CurWeek)

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.

TextReport

Can you not just have the weeeks name Week01 to Week12?
Cheers, Andrew

ASKER CERTIFIED SOLUTION

ee_rlee

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

GRayL

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

Open in new window