Determine Week Number from Date

Category:

Dates and Math

Type:

Snippets

Difficulty:

Beginning

Author:

Jeff Winn

Version Compatibility:

More information:

This function retrieves the week number from the date passed to the function.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

Public Function Week(ByVal inDate As Date) As Integer
    If IsDate(inDate) = False Then Exit Function
    
    Dim iDay As Integer, iMonth As Integer, iWeek As Integer, addDay As Integer
    
    iDay = 0
    Do
        iMonth = iMonth + 1
        Do
            If ((iMonth = Month(inDate)) And (iDay >= Day(inDate))) Or (iMonth > Month(inDate)) Then _
                    Week = iWeek: Exit Function
                    
            iDay = iDay + 1
            Select Case Weekday(iMonth & "/" & iDay & "/" & Year(inDate))
            Case 1: addDay = 6: iDay = iDay + addDay 'Sunday
            Case 2: addDay = 5: iDay = iDay + addDay 'Monday
            Case 3: addDay = 4: iDay = iDay + addDay 'Tuesday
            Case 4: addDay = 3: iDay = iDay + addDay 'Wednesday
            Case 5: addDay = 2: iDay = iDay + addDay 'Thursday
            Case 6: addDay = 1: iDay = iDay + addDay 'Friday
            End Select
            iWeek = iWeek + 1
            
            If IsDate(iMonth & "/" & (iDay + 1) & "/" & Year(inDate)) = False Then
                iDay = iDay - addDay
                'Determine the actual end of the month
                Do While IsDate(iMonth & "/" & iDay & "/" & Year(inDate)): iDay = iDay + 1: Loop
                iDay = iDay - 1
                'Determine how many days left in the week are for the next month.
                iDay = 7 - Weekday(iMonth & "/" & iDay & "/" _
                    & Year(inDate))
                Exit Do
            End If
        Loop
    Loop Until iMonth = 12
    
    Week = iWeek
End Function