We help IT Professionals succeed at work.

First Monday of week

FEAssociates
FEAssociates asked
on
Medium Priority
969 Views
Last Modified: 2008-02-01
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.
Comment
Watch Question

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:
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.
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
    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
            sharedrow=false
        Else
            Me(CurLbl).Caption = ""
            sharedrow=true
        End If
        CurWeek = DateAdd("ww", 1, CurWeek)
    CurMth = Mid(Format(CurWeek, "Medium Date"), 4, 3)
    Next x
    if sharedrow then
        CurWeek = DateAdd("ww", -1, CurWeek)
    end if
Next I
End Sub

Open in new window

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

Open in new window

Explore More ContentExplore courses, solutions, and other research materials related to this topic.