Function WeekNumber(ByVal dteYear As Date) As Integer
On Error GoTo Err_WeekNumber
' Author: Mile-O-Phile
' Discussion: This function is designed to return the week number that a specific date appears in.
' Although, mahematically, there are generally 52 weeks in a year, the problem of leap
' years add a further day for consideration that would make a 53rd week that includes only
' one day. This is handled here by using the final day of a leap year as an 8th day in
' the 52nd week.
' Input(s): dteYear - the date value for which the user wishes to calculate the week number
' Process: check if year of chosen date is a leap year
' calculate week number
' Output(s): WeekNumber- the number, representing a week, that a date appears in a year (as an integer)
Dim dteCount As Date, intCounter As Integer, booLeapYear As Boolean
' if year divided by 4 returns no remainder then the year is a leap year
If Year(dteYear) Mod 4 = 0 Then booLeapYear = True
' get first date of year as a starting point
dteCount = DateSerial(Year(dteYear), 1, 1)
' check if date chosen is first date of year
If dteYear = dteCount Then
WeekNumber = WeekNumber + 1
Else
' check if the hosen date is within the latest date-check increment
While dteYear > dteCount
dteCount = dteCount + 7
WeekNumber = WeekNumber + 1
' ensure that the leap year's extra day problem is resolved
If WeekNumber = 53 And booLeapYear = True Then WeekNumber = 52
Wend
End If
Exit_WeekNumber:
Exit Function
Err_WeekNumber:
MsgBox Err.Number & Err.Description
Resume Exit_WeekNumber
End Function
