Binaryworld - Monday - retrieving the date of the Monday for a specified week ... [ VB -> Date-Time ]

' Return the date of the Monday for a specified week..
' This function can be tweaked to return any weekday. I use it in Access to
' subdivide reports into weekly units, since Access displays only a number
' between 1 and 53 for the week when you group dates by week.
'
' Note: the Monday function requires the presence of the IsLeapYear function,
' as well as the two arguments for the year and the week.

Public Function Monday(intYear As Integer, intWeek As Integer) As Date
  Static intMonday(53) As Date
  Dim i As Long, x As Integer
  Dim datDayNum As Date
  Dim intNumDays As Integer

  If IsLeapYear(intYear) Then
    intNumDays = 365
  Else
    intNumDays = 364
  End If

  datDayNum = DateSerial(intYear, 1, 1)

  If WeekDay(datDayNum) >= 3 And WeekDay(datDayNum) <= 6 Then
    For i = datDayNum - 7 To datDayNum + intNumDays
      If WeekDay(i) = 2 Then
        x = x + 1
        intMonday(x) = CDate(i)
      End If
    Next
  Else
    For i = datDayNum To datDayNum + intNumDays
      If WeekDay(i) = 2 Then
        x = x + 1
        intMonday(x) = CDate(i)
      End If
    Next
  End If
  ' And finally:
  Monday = intMonday(intWeek)
End Function

' This relatively simple function should work fine for any year between 100 and
' 9999, using the Gregorian calendar.
' As you can see, it tests the year for whether it is a multiple of 4, 100,
' or 400, using the Mod operator. It does not allow for years that VB can't
' handle.

Public Function IsLeapYear(intYear As Integer) As Boolean
  ' Multiples of 100 that are not also multiples of 400 are not leap years;
  ' thus, 1900 was not, but 2000 was.

  If intYear < 100 Or intYear > 9999 Then
    MsgBox "The year provided must be between 100 and 9999, inclusive."
    Exit Function
  End If

  If intYear Mod 400 = 0 Then
    IsLeapYear = True
  ElseIf intYear Mod 100 = 0 Then
    IsLeapYear = False
  ElseIf intYear Mod 4 = 0 Then
    IsLeapYear = True
  Else
    IsLeapYear = False
  End If
End Function