Results 1 to 3 of 3
  1. #1
    Join Date
    Jul 2004
    Posts
    24

    Unanswered: Convert weeknumber to dates

    I would like to know which dates match with the current weeknumber

    Example.> This week is weeknumber 31.

    I want to use this weeknumber as input and get 26-07-2004 until 01-08-2004 back.

    How can I achieve that?

    Thanks very much in advance,

    Bob from Belgium

  2. #2
    Join Date
    Mar 2004
    Location
    www.scirocco.ca
    Posts
    346
    Here is a function to convert a week number to a date range:

    Code:
    Public Function myWeekRange(WeekNum As Integer, Optional fmt As Integer = 0, Optional sdy As Integer = 0) As String
    ' fmt = Format options: Range = 0 to 8
    '       0 = Week 17: 4/18/04 - 4/24/04 (default)
    '       1 = Week 17: 4/18/2004 - 4/24/2004
    '       2 = Week 17: April 18, 2004 - April 24, 2004
    '       3 = Week 17: April 18 - 24, 2004
    '       4 = 4/18/04 - 4/24/04
    '       5 = 4/18/2004 - 4/24/2004
    '       6 = 4/18 - 24/2004
    '       7 = April 18, 2004 - April 24, 2004
    '       8 = April 18 - 24, 2004
    '
    ' sdy = Starting Day of Week options: Range = 0 to 6
    '       0 = Sunday (default)
    '       1 = Monday
    '       2 = Tuesday (and so forth)
    '
    ' USAGE:
    ' In the debug window, ?myWeekRange(17) will yield "Week 17: 4/18/04 - 4/24/04"
    ' In the debug window, ?myWeekRange(17,1) will yield "Week 17: 4/18/2004 - 4/24/2004"
    ' In the debug window, ?myWeekRange(17,1,1) will yield "Week 17: 4/19/2004 - 4/25/2004"
    ' In the debug window, ?myWeekRange(17,5,2) will yield "4/20/2004 - 4/26/2004"
    ' and so forth. 
    '
    ' You can also use it in queries: DtRng: myWeekRange(Format([Date],'ww'),1,1)
    '
        
    Dim StartDate As Date
    Dim StartRange As Date
    Dim EndRange As Date
    Dim numDays As Long
    Dim maxWk As Long
    Dim fwDays As Long            ' stores the number of days in the first week of the year
    Dim dtTmpDate As Date
    Dim i As Integer, w As String
    Dim sdFmt As String           ' stores the format string for the week start date
    Dim edFmt As String           ' stores the format string for the week end date
        
    ' Validate format option value and msg user if out of range
        If fmt < 0 Or fmt > 8 Then
            MsgBox "That is not a valid format option." & vbCrLf & vbCrLf & _
                   "Format options are:" & vbCrLf & _
                   "    0 = 'Week 17: 4/18/04 - 4/24/04' (default)" & vbCrLf & _
                   "    1 = 'Week 17: 4/18/2004 - 4/24/2004'" & vbCrLf & _
                   "    2 = 'Week 17: April 18, 2004 - April 24, 2004'" & vbCrLf & _
                   "    3 = 'Week 17: April 18 - 24, 2004'" & vbCrLf & _
                   "    4 = '4/18/04 - 4/24/04'" & vbCrLf & _
                   "    5 = '4/18/2004 - 4/24/2004'" & vbCrLf & _
                   "    6 = '4/18 - 24/2004'" & vbCrLf & _
                   "    7 = 'April 18, 2004 - April 24, 2004'" & vbCrLf & _
                   "    8 = 'April 18 - 24, 2004'", vbExclamation, "Invalid Week"
            Exit Function
        End If
        
    ' Validate first day of week (sdy) option value and msg user if out of range
        If sdy < 0 Or sdy > 6 Then
            MsgBox "That is not a valid First Day of Week option." & vbCrLf & vbCrLf & _
                   "Format options are:" & vbCrLf & _
                   "    0 = Sunday (default)" & vbCrLf & _
                   "    1 = Monday" & vbCrLf & _
                   "    2 = Tuesday" & vbCrLf & _
                   "    3 = Wednesday" & vbCrLf & _
                   "    4 = Thursday" & vbCrLf & _
                   "    5 = Friday" & vbCrLf & _
                   "    6 = Saturday", vbExclamation, "Invalid First Day of Week"
            Exit Function
        End If
        
    ' Determine the maximum week number of the current year
        maxWk = Format(CDate(Format("12/31/" & Year(Now()), "m/d/yyyy")), "ww")
        If WeekNum > maxWk Or WeekNum < 1 Then
            MsgBox "That is not a valid week number.", vbExclamation, "Invalid Week"
            Exit Function
        End If
        
    ' Set the date of the first day of the current year
        StartDate = CDate(Format("01/01/" & Year(Now()), "m/d/yyyy"))
        
        dtTmpDate = DateSerial(Year(StartDate), Month(StartDate), 1)
        
    ' Determine the number of days in the first week of the current year
        For i = 1 To 7
          If WeekDay(dtTmpDate) = vbSunday Then
            fwDays = Format(dtTmpDate, "d") - sdy
            Exit For 
          End If
          dtTmpDate = dtTmpDate + 1
        Next i
        
    ' Establish the Date Ranges of the week
        numDays = (7 * (WeekNum - 1)) - fwDays
        StartRange = DateAdd("d", numDays, StartDate)
        EndRange = DateAdd("d", 6, StartRange)
        
        If fmt < 4 Then
            w = "Week " & WeekNum & ": "
          Else
            w = ""
        End If
        
    ' Render the Date Range output format
        Select Case fmt
            Case 0, 4
                sdFmt = "m/d/yy"
                edFmt = "m/d/yy"
            Case 1, 5
                sdFmt = "m/d/yyyy"
                edFmt = "m/d/yyyy"
            Case 2, 7
                sdFmt = "mmmm d, yyyy"
                edFmt = "mmmm d, yyyy"
            Case 3
                sdFmt = "mmmm/d"
                edFmt = "d/yyyy"
            Case 6
                sdFmt = "m/d"
                edFmt = "d/yyyy"
            Case 8
                sdFmt = "mmmm d"
                edFmt = "d, yyyy"
            Case Else
                myWeekRange = "something broke"
                Exit Function
        End Select
        
    ' Render the Date Range output
        myWeekRange = w & Format(StartRange, sdFmt) & " - " & Format(EndRange, edFmt)
        
    End Function
    http://www.scirocco.ca/images/banner...occobanner.gif

    Download for FREE the ADO/DAO Data Controls that makes life EASIER developing database applications in: VB, FoxPro, Access, VC++, .NET etc... Navigate, Add New, Delete, Update, Search, Undo and Save your changes. Supports Disconnected Recordsets and Transactions!

    Or try our Ask An Expert service to answer any of your questions!

  3. #3
    Join Date
    Jul 2004
    Posts
    24

    Thanks!! This function works great!

    Scirocco,

    This function works great! Thanks very much, you made my day.

    Greetings,

    Brussels Bob

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •