This bit of sample code converts a date in gregorian to an ISO week #. I have a text field on a form called pDate where the user will input a date. Then I want to run this code using the date that was just entered. If your lookinf for a challenge, please help me out... Here is the sample code:
Public Function DateToWeek(ByVal datDate As Date, _
Optional ByVal bytTruncFormat As Byte = 0, _
Optional ByVal bytShortLongFormat As Byte = 0) As String
'******************************************************************************
'
' Macro created 2003-03-18 by Nikolai Sandved (nsaa@pvv.org)
'
' Description: This Function return the ISO8601 week
' This code appears on the site
' http://www.probabilityof.com/ISO8601.shtml
' http://www.probabilityof.com/excel.shtml
'
' The week calculations follow the ISO 8601 standard
' http://dmoz.org/Science/Reference/Standard...dards/ISO_8601/
'
'
' Input:
' datDate - Microsoft Excel date
' Optional
' bytShortLongFormat 0 - Long format(default) : YYYY-Www-D
' 1 - Short format : YYYYWwwD
' bytTruncFormat 0 - Year, week and day(default) : YYYY-Www-D/YYYYWwwD
' 1 - Year and week : YYYY-Www/YYYYWww
' 2 - Year : YYYY
' 3 - Week and day : Www-D/WwwD
' 4 - Week : Www
' 5 - Only Week : ww
' Output:
' DateToWeek - A string following the pattern "YYYY-Www-D" (Default)
'
' Same calculations in Excel can be done like this (in US change ; to ,):
' Cell(A1) =date in Excel
' Cell(B1) =RIGHT("0" & 1+INT((A1-DATE(YEAR(A1+4-WEEKDAY(A1+6));1;5)
' + WEEKDAY(DATE(YEAR(A1+4-WEEKDAY(A1+6));1;3)))/7);2)
' Cell(C1) =IF(AND(MONTH(A1)=12;B1="01");
' YEAR(A1)+1;
' IF(AND(MONTH(A1)=1;OR(B1="52";B1="53"));
' YEAR(A1)-1;
' YEAR(A1)))
' &"-W" & B1 & "-" & WEEKDAY(A1;2)
'
'
'The following two rules applies when converting a gregorian date to the ISO week
'and vice versa
'Rule 1 January 4th. is always in week 01
'Rule 2 Always 52 or 53(leap week) ISO week in a given year: "A year has a leap
' week if and only if the corresponding Gregorian year begins on a Thursday or
' is a leap year begining on a Wednesday or a Thursday. By definition, its new
' year varies just 6 days against the Gregorian Calendar (3 days early to 3
' days late)."
'Rule 3 A ISO week start at a Monday(1) and ends at a Sunday (7)
'From http://serendipity.magnet.ch/hermetic/cal_...lmen/lweek1.htm
'
'Example rule 1
' January 4th. 1993 is on a Monday(1993-01-04)
' 1993-01-03 -> 1992-W53-7
' 1993-01-04 -> 1993-W01-1
' January 4th. 1998 is on a Sunday (1998-01-04)
' 1997-12-28 -> 1997-W52-7
' 1997-12-29 -> 1998-W01-1
' 1998-01-04 -> 1998-W01-7
'Example rule 2
' Year start at a Thursday
' 1998-01-01 -> 1998-W01-4 (i.e a Thursday)
' 1998-12-31 -> 1998-W53-4 (->Leap week!)
' Year start at a Wednesday and is a Leap year
' 1992-01-01 -> 1992-W01-3 (i.e a Wednesday)
' 1992-02-29 -> 1992-W09-6 (and a Leap Year)
' 1992-12-31 -> 1992-W53-4 (->Leap week!)
' Year start at a Wednesday and is NOT a Leap year
' 1975-01-01 -> 1975-W01-3 (i.e a Wednesday)
' 1975-02-29 -> ERROR, No date, No Leap year
' 1975-12-28 -> 1975-W52-7
' 1975-12-29 -> 1976-W01-1 (No Leap week in 1975)
'
' Keyboard Shortcut:
'
'******************************************************************************
'** Error Control
On Error GoTo ErrorHandle
' ** Define variables
Dim byteWeekNumber As Byte 'The weeknumber (Between 1 and 53)
Dim strWeekNumber As String 'The weeknumber (Between 01 and 53)
Dim intWeekYear As Integer 'The weeknumberyear ()
Dim strShortLongFormat As String 'If long then "-"
'Calculates the weeknumber
'From http://www.cpearson.com/excel/weeknum.htm
'=1+INT((A1-DATE(YEAR(A1+4-WEEKDAY(A1+6)),1,5)+
' WEEKDAY(DATE(YEAR(A1+4-WEEKDAY(A1+6)),1,3)))/7)
byteWeekNumber = 1 + Int((datDate - DateSerial(Year(datDate + 4 _
- Weekday(datDate + 6)), 1, 5) + Weekday(DateSerial(Year(datDate + 4 _
- Weekday(datDate + 6)), 1, 3))) / 7)
'Adds leading 0 to weeknumbers less than 10
strWeekNumber = Right$("0" & byteWeekNumber, 2)
'Calculates the correct week year if necesarry
If bytTruncFormat < 3 Then
'If weekyear is one year ahead
If (Month(datDate) = 12 And strWeekNumber = "01") Then
intWeekYear = Year(datDate) + 1
'If weekyear is one year after
ElseIf (Month(datDate) = 1 And (strWeekNumber = "52" _
Or strWeekNumber = "53")) Then
intWeekYear = Year(datDate) - 1
'Same year
Else
intWeekYear = Year(datDate)
End If
End If 'bytTruncFormat < 3
' If long format add "-"
If bytShortLongFormat = 1 Then
strShortLongFormat = ""
Else
strShortLongFormat = "-"
End If
'Selects correct truncated format
Select Case bytTruncFormat
Case 0
DateToWeek = CStr(intWeekYear) & strShortLongFormat & "W" _
& strWeekNumber & strShortLongFormat _
& Weekday(datDate, vbMonday)
Case 1
DateToWeek = CStr(intWeekYear) & strShortLongFormat & "W" _
& strWeekNumber
Case 2
DateToWeek = CStr(intWeekYear)
Case 3
DateToWeek = "W" & strWeekNumber & strShortLongFormat _
& Weekday(datDate, vbMonday)
Case 4
DateToWeek = "W" & strWeekNumber
Case 5
DateToWeek = strWeekNumber
Case Else
DateToWeek = CStr(intWeekYear) & strShortLongFormat & "W" _
& strWeekNumber & strShortLongFormat _
& Weekday(datDate, vbMonday)
End Select
Exit Function
ErrorHandle:
'** Set the return error objects
MsgBox ("Error code:" & CStr(Err) & Chr(13) & Chr(13) _
& "Further Description: " & Error$)
End Function