• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1366
  • Last Modified:

MS Access 2007 query or VBA to create 52 consecutive work weeks : Mondays and Fridays only in combobox

How do I, in MS Access 2007, create either a query or a VBA code to show the following dates for a combobox that lists:

52 consecutive work weeks : Mondays and Fridays only
starting with the first week in the year and ending with the last week of the year.
 
Monday  - Friday
=================
1/2/2012 - 1/6/2012
- etc -
8/6/2012 - 8/10/2012
8/13/2012 - 8/17/2012
- etc -
12/31/2012 - 1/4/2013

Thank you.
0
DeMyu
Asked:
DeMyu
1 Solution
 
Gustav BrockCIOCommented:
You will use a list function for this. Here is how to obtain a week list:

Function ListWeeknumbers( _
  ctl As Control, _
  lngNum As Long, _
  lngRow As Long, _
  lngCol As Long, _
  intCode As Integer) As Variant

' Creates a list of week numbers of current year according to the ISO 8601:1988 standard.

  Select Case intCode
    Case acLBInitialize             ' Initialize.
      ListWeeknumbers = True
    Case acLBOpen                   ' Open.
      ListWeeknumbers = Timer       ' Unique number as check.
    Case acLBGetRowCount            ' Count of rows. Highest weeknumber in current year.
      ListWeeknumbers = ISO_WeekCount(Date)
    Case acLBGetColumnCount         ' Count of coloums.
      ListWeeknumbers = 1
    Case acLBGetColumnWidth         ' Coloumn width.
      ListWeeknumbers = -1          ' Use default width.
    Case acLBGetValue               ' Fetch data.
      ListWeeknumbers = lngRow + 1  ' First row is 0.
    Case acLBEnd                    ' Close.
      '                             ' Nothing to do.
  End Select

End Function

Open in new window

which uses this function as VB(A) is buggy for week 52/53:
Public Function ISO_WeekCount( _
  ByVal datYear As Date) _
  As Byte

' Calculates number of weeks in year of datYear according to the ISO 8601:1988 standard.
'
' May be freely used and distributed.
' 2001-06-26. Gustav Brock, Cactus Data ApS, CPH

  Dim bytISO_Thursday As Byte

  ' No special error handling.
  On Error Resume Next
  
  bytISO_Thursday = WeekDay(vbThursday, vbMonday)
  
  datYear = DateSerial(Year(datYear), 12, 31)
  ' Subtract one week if datYear is in week no. 1 of next year.
  datYear = DateAdd("ww", WeekDay(datYear, vbMonday) < bytISO_Thursday, datYear)
  
  ISO_WeekCount = DatePart("ww", datYear, vbMonday, vbFirstFourDays)
  
End Function

Open in new window

Look up the on-line for how to use list functions for combo and list boxes - one of the small gems of Access!

This list function lists the dates of each week:
Function ListWeeksOfTwoYears( _
  ctl As Control, _
  lngId As Long, _
  lngRow As Long, _
  lngCol As Long, _
  intCode As Integer) As Variant

  ' Creates a list of week number, start date, and end date of current and next year
  ' according to the ISO 8601:1988 standard.
  '
  ' 2011-05-02. Gustav Brock, Cactus Data ApS, CPH.

  ' Choose first day of week to display in column(1).
  Const cbytDayFirst    As Byte = vbMonday
  ' Choose last day of week to display in column(2).
  Const cbytDayLast     As Byte = vbFriday
  ' Format of dates.
  Const cstrDateFormat  As String = "yyyy\-mm\-dd"
  
  Static datDateFirst   As Date
  Static datDateLast    As Date
  
  Static intDaysYear1   As Integer
  Static intDaysYear2   As Integer
  
  Dim varValue          As Variant
  
  Select Case intCode
    Case acLBInitialize           ' Initialize function.
      ' Count of weeks.
      intDaysYear1 = ISO_WeekCount(Year(Date))
      intDaysYear2 = ISO_WeekCount(Year(Date) + 1)
      ' First and last date of first week.
      datDateFirst = ISO_DateOfWeek(Year(Date), 1, cbytDayFirst)
      datDateLast = ISO_DateOfWeek(Year(Date), 1, cbytDayLast)
      varValue = True             ' True to initialize.
    Case acLBOpen
      varValue = Timer            ' Autogenerated unique ID.
    Case acLBGetRowCount          ' Get rows.
      ' Set number of rows.
      varValue = intDaysYear1 + intDaysYear2
    Case acLBGetColumnCount       ' Get columns.
      varValue = 3                ' Set number of columns.
    Case acLBGetColumnWidth       ' Get column width
      ' Set column widths in twips.
      If lngCol = 0 Then
        ' Column width of week number column.
        varValue = 300
      Else
        ' Column width of date columns.
        varValue = 920
      End If
    Case acLBGetValue             ' Get the data.
      If lngCol = 0 Then
        ' Week number of this week.
        varValue = lngRow + 1
        If varValue > intDaysYear1 Then
          ' This is a week number of the second year.
          varValue = varValue - intDaysYear1
        End If
        ' Optional. Right justify week number.
        If varValue < 10 Then
          varValue = Space(2) & varValue
        End If
      Else
        ' Week date.
        If lngCol = 1 Then
          ' Calculate first date of this week.
          varValue = DateAdd("ww", lngRow, datDateFirst)
        Else
          ' Calculate last date of this week.
          varValue = DateAdd("ww", lngRow, datDateLast)
        End If
      End If
    Case acLBGetFormat            ' Format the data.
      If lngCol > 0 Then
        ' Apply date format.
        varValue = cstrDateFormat
      End If
    Case acLBEnd
      ' Do something when form with listbox closes or
      ' listbox is requeried.
  End Select
  
  ' Return Value.
  ListWeeksOfTwoYears = varValue

End Function

Open in new window


using this function:
Public Function ISO_DateOfWeek( _
  ByVal intYear As Integer, _
  ByVal bytWeek As Byte, _
  Optional ByVal bytWeekday As Byte = vbMonday) _
  As Date

' Calculates date of requested weekday in a week of
' a year according to ISO 8601:1988 standard.
'
' Notes:  Years less than 100 will be handled as
'         two-digit years of our current year frame.
'         Years less than zero returns a zero date.
'         A weeknumber of zero returns the requested
'         weekday of the week before week 1.
'
' 2000-12-17. Cactus Data ApS, Gustav Brock.

  ' The fourth of January is always included in
  ' the first week of year intYear.
  Const cbytDayOfFirstWeek  As Byte = 4
  ' Number of days in a week.
  Const cbytDaysOfWeek      As Byte = 7
  ' Month of January.
  Const cbytJanuary         As Byte = 1
  
  Dim datDateOfFirstWeek    As Date
  Dim intISOMonday          As Integer
  Dim intISOWeekday         As Integer
  Dim intWeekdayOffset      As Integer
  
  ' No specific error handling.
  On Error Resume Next
    
  If intYear > 0 Then
    ' Weekday of Monday.
    intISOMonday = WeekDay(vbMonday, vbMonday)
    ' Date of fourth of January in year intYear.
    datDateOfFirstWeek = DateSerial(intYear, cbytJanuary, cbytDayOfFirstWeek)
    ' Weekday of fourth of January in year intYear.
    intISOWeekday = WeekDay(datDateOfFirstWeek, vbMonday)
    ' Calculate offset from Monday in first week of year intYear.
    intWeekdayOffset = intISOMonday - intISOWeekday
    
    ' Weekday of requested weekday.
    intISOWeekday = WeekDay(bytWeekday, vbMonday)
    ' Calculate offset from requested weekday in first week of year intYear.
    intWeekdayOffset = intWeekdayOffset + intISOWeekday - intISOMonday
    ' Date of requested weekday in first week of year intYear.
    datDateOfFirstWeek = DateAdd("d", intWeekdayOffset, datDateOfFirstWeek)
  
    ' Date of requested weekday in requested week of year intYear.
    datDateOfFirstWeek = DateAdd("ww", bytWeek - 1, datDateOfFirstWeek)
  End If
  
  ISO_DateOfWeek = datDateOfFirstWeek
  
End Function

Open in new window


/gustav
0
 
IrogSintaCommented:
Another solution you could try is with the AddItem Method.  Add this code to your form's OnLoad event:
    Dim dtFirstDay As Date, dtMonday As Date
    
    dtFirstDay = DateSerial(Year(Date), 1, 1)
    dtMonday = dtFirstDay + (7 - Weekday(dtFirstDay, vbTuesday))
    
    Me.NameOfComboBox.RowSourceType = "Value List"
    Do Until Year(dtMonday) <> Year(Date)
        Me.NameOfComboBox.AddItem Format(dtMonday, "mm/dd/yy") & " - " & Format(dtMonday + 4, "mm/dd/yy")
        dtMonday = dtMonday + 7
    Loop

Open in new window

0
 
DeMyuAuthor Commented:
Thank you. A solution with a very small footprint. I am actually very grateful for all those who contributed their inputs.
0

Featured Post

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now