Advanced Timesheet with Access


Introduction

A few years ago, in Access Archon #127, I showed how to make an Access form for entering timesheet data, which was then exported to Excel. That timesheet had combo boxes in the header to select a project and a week, and columns for entering data for the days of the week. This article adds another layer of complexity to a timesheet form, allowing users to enter data for multiple projects in a week, and then storing the timesheet data by work day in a table. This requires converting a single row of data in a temp table to multiple rows in the data table, and then (for purposes of updating hours), converting multiple rows in the data table back to a single row in the temp table, a technique that can be handy in many situations.

The Form

The Timesheet form has combo box selectors in the header, for selecting an employee and a week ending date (a table is filled with these dates, going back eight weeks from the present date, by a procedure called from the form’s Open event). After both values are selected, dates appear over the weekday columns, and you can enter the time worked in the datasheet subform. The screen shot below shows several projects entered for employee Bob Surtcliff in the week ending 6/28/2015:
AW 1707-BFigure A. The Timesheet form

The Write Weekly Hours to Table and Close button writes the data from the datasheet subform (which is temporarily stored in tblTimesheetDataTemp) to tblTimesheetData. The Cancel and Close button allows you to close the form without saving the data, and the Clear Timesheet button clears the data on the form and subform (and in the temp table), so you can enter another employee’s hours.

VBA Code

There are two procedures which do the work of writing and retrieving the timesheet data. When writing the data, values from a single row in the datasheet are saving to different records in tblTimesheetData, while when data is retrieved, multiple rows of data in tblTimesheetData are converted into single rows on the datasheet (one row per employee-project-week ending combination).

1
Public Sub WriteTimesheetData()
1
<strong><em>'Writes newly created or modified data from temp table to tblTimeSheetData</em></strong>
1
 
1
On Error GoTo ErrorHandler
1
 
1
   Set rstTime = CurrentDb.OpenRecordset("tblTimeSheetData", _
1
     dbOpenDynaset)
1
   Set rstTemp = CurrentDb.OpenRecordset("tblTimeSheetDataTemp")
1
 
1
<strong><em>   'Clear old records</em></strong>
1
   DoCmd.SetWarnings False
1
   DoCmd.OpenQuery "qdelTimePerEmployeeAndWeek"
1
 
1
   With rstTemp
1
     .MoveLast
1
     .MoveFirst
1
     lngCount = .RecordCount
1
     Debug.Print lngCount &amp; " records to write"
1
 
1
     If lngCount &gt; 0 Then
1
<strong><em>         'Create one record in tblTimeSheetData for each weekday</em></strong>
1
<strong><em>         'that has hours worked</em></strong>
1
         Do While Not .EOF
1
           lngEmployeeID = Nz(![EmployeeID])
1
           curPayRate = Nz(![PayRate])
1
           lngProjectID = Nz(![ProjectID])
1
           lngAdminID = Nz(![AdminID])
1
 
1
           dblWorkHours = Nz(![MondayWorkHours])
1
 
1
           If dblWorkHours &gt; 0 Then
1
               dteWork = DateAdd("d", -6, _
1
                 GetProperty("TimesheetWeekEnding", ""))
1
 
1
<strong><em>              'Add new record</em></strong>
1
               rstTime.AddNew
1
               rstTime![EmployeeID] = ![EmployeeID]
1
               rstTime![WorkDate] = dteWork
1
               If lngProjectID &lt;&gt; 0 Then
1
                 rstTime![ProjectID] = ![ProjectID]
1
              End If
1
               If lngAdminID &lt;&gt; 0 Then
1
                 rstTime![AdminID] = ![AdminID]
1
               End If
1
               rstTime![WorkHours] = dblWorkHours
1
               rstTime![WorkDescription] = ![WorkDescription]
1
               rstTime![PayRate] = curPayRate
1
               rstTime.Update
1
           End If
1
 
1
           dblWorkHours = Nz(![TuesdayWorkHours])
1
 
1
           If dblWorkHours &gt; 0 Then
1
               dteWork = DateAdd("d", -5, _
1
                 GetProperty("TimesheetWeekEnding", ""))
1
 
1
<strong><em>               'Add new record</em></strong>
1
               rstTime.AddNew
1
               rstTime![EmployeeID] = ![EmployeeID]
1
               rstTime![WorkDate] = dteWork
1
               If lngProjectID &lt;&gt; 0 Then
1
                rstTime![ProjectID] = ![ProjectID]
1
               End If
1
               If lngAdminID &lt;&gt; 0 Then
1
                 rstTime![AdminID] = ![AdminID]
1
               End If
1
               rstTime![WorkHours] = dblWorkHours
1
               rstTime![WorkDescription] = ![WorkDescription]
1
               rstTime![PayRate] = curPayRate
1
               rstTime.Update
1
           End If
1
 
1
           dblWorkHours = Nz(![WednesdayWorkHours])
1
 
1
           If dblWorkHours &gt; 0 Then
1
              dteWork = DateAdd("d", -4, _
1
                 GetProperty("TimesheetWeekEnding", ""))
1
 
1
<strong><em>               'Add new record</em></strong>
1
               rstTime.AddNew
1
               rstTime![EmployeeID] = ![EmployeeID]
1
               rstTime![WorkDate] = dteWork
1
               If lngProjectID &lt;&gt; 0 Then
1
                 rstTime![ProjectID] = ![ProjectID]
1
               End If
1
               If lngAdminID &lt;&gt; 0 Then
1
                 rstTime![AdminID] = ![AdminID]
1
               End If
1
               rstTime![WorkHours] = dblWorkHours
1
               rstTime![WorkDescription] = ![WorkDescription]
1
               rstTime![PayRate] = curPayRate
1
               rstTime.Update
1
           End If
1
 
1
           dblWorkHours = Nz(![ThursdayWorkHours])
1
 
1
           If dblWorkHours &gt; 0 Then
1
               dteWork = DateAdd("d", -3, _
1
                 GetProperty("TimesheetWeekEnding", ""))
1
 
1
<strong><em>               'Add new record</em></strong>
1
               rstTime.AddNew
1
               rstTime![EmployeeID] = ![EmployeeID]
1
               rstTime![WorkDate] = dteWork
1
               If lngProjectID &lt;&gt; 0 Then
1
                 rstTime![ProjectID] = ![ProjectID]
1
               End If
1
               If lngAdminID &lt;&gt; 0 Then
1
                 rstTime![AdminID] = ![AdminID]
1
               End If
1
               rstTime![WorkHours] = dblWorkHours
1
               rstTime![WorkDescription] = ![WorkDescription]
1
               rstTime![PayRate] = curPayRate
1
               rstTime.Update
1
           End If
1
 
1
           dblWorkHours = Nz(![FridayWorkHours])
1
 
1
           If dblWorkHours &gt; 0 Then
1
               dteWork = DateAdd("d", -2, _
1
                 GetProperty("TimesheetWeekEnding", ""))
1
 
1
<strong><em>               'Add new record</em></strong>
1
               rstTime.AddNew
1
               rstTime![EmployeeID] = ![EmployeeID]
1
               rstTime![WorkDate] = dteWork
1
               If lngProjectID &lt;&gt; 0 Then
1
                 rstTime![ProjectID] = ![ProjectID]
1
               End If
1
             If lngAdminID &lt;&gt; 0 Then
1
                 rstTime![AdminID] = ![AdminID]
1
               End If
1
               rstTime![WorkHours] = dblWorkHours
1
               rstTime![WorkDescription] = ![WorkDescription]
1
               rstTime![PayRate] = curPayRate
1
             rstTime.Update
1
           End If
1
 
1
           dblWorkHours = Nz(![SaturdayWorkHours])
1
 
1
           If dblWorkHours &gt; 0 Then
1
               dteWork = DateAdd("d", -1, _
1
                 GetProperty("TimesheetWeekEnding", ""))
1
 
1
<strong><em>               'Add new record</em></strong>
1
               rstTime.AddNew
1
               rstTime![EmployeeID] = ![EmployeeID]
1
               rstTime![WorkDate] = dteWork
1
               If lngProjectID &lt;&gt; 0 Then
1
                 rstTime![ProjectID] = ![ProjectID]
1
               End If
1
               If lngAdminID &lt;&gt; 0 Then
1
                 rstTime![AdminID] = ![AdminID]
1
               End If
1
               rstTime![WorkHours] = dblWorkHours
1
               rstTime![WorkDescription] = ![WorkDescription]
1
               rstTime![PayRate] = curPayRate
1
               rstTime.Update
1
           End If
1
 
1
           dblWorkHours = Nz(![SundayWorkHours])
1
 
1
           If dblWorkHours &gt; 0 Then
1
               dteWork = GetProperty("TimesheetWeekEnding", "")
1
 
1
<strong><em>               'Add new record</em></strong>
1
               rstTime.AddNew
1
               rstTime![EmployeeID] = ![EmployeeID]
1
               rstTime![WorkDate] = dteWork
1
               If lngProjectID &lt;&gt; 0 Then
1
                rstTime![ProjectID] = ![ProjectID]
1
               End If
1
               If lngAdminID &lt;&gt; 0 Then
1
                 rstTime![AdminID] = ![AdminID]
1
               End If
1
               rstTime![WorkHours] = dblWorkHours
1
               rstTime![WorkDescription] = ![WorkDescription]
1
               rstTime![PayRate] = curPayRate
1
               rstTime.Update
1
           End If
1
 
1
           .MoveNext
1
         Loop
1
     End If
1
   End With
1
 
1
ErrorHandlerExit:
1
   Exit Sub
1
 
1
ErrorHandler:
1
   MsgBox "Error No: " &amp; Err.Number _
1
     &amp; " in WriteTimesheetData procedure; " _
1
     &amp; "Description: " &amp; Err.Description
1
   Resume ErrorHandlerExit
1
 
1
End Sub
1
 
1
Public Sub GetTimesheetData()
1
<strong><em>'Retrieves a set of records for an employee and a week</em></strong>
1
<strong><em>'from tblTimeSheetData, and uses them to populate datasheet subform</em></strong>
1
<strong><em>'which is bound to tblTimeSheetDataTemp</em></strong>
1
 
1
On Error GoTo ErrorHandler
1
 
1
   Set rstWorkIDs = CurrentDb.OpenRecordset("qryWorkIDsPerEmployeeAndWeek")
1
   Set rstTemp = CurrentDb.OpenRecordset("tblTimeSheetDataTemp")
1
 
1
   strRecordSource = "qryTimePerEmployeeAndWeek"
1
   strQuery = "qryWorkPerWorkID"
1
 
1
   With rstWorkIDs
1
     .MoveLast
1
     .MoveFirst
1
     lngCount = .RecordCount
1
   End With
1
 
1
   Debug.Print lngCount &amp; " Work IDs"
1
 
1
   Do While Not rstWorkIDs.EOF
1
     strWorkID = rstWorkIDs![WorkID]
1
     rstTemp.AddNew
1
 
1
<strong><em>     'Make a filtered query for this WorkID and write data</em></strong>
1
<strong><em>     'to tblTimeSheetTemp</em></strong>
1
     strSQL = "SELECT * FROM " &amp; strRecordSource &amp; " WHERE " _
1
       &amp; "[WorkID] = " &amp; Chr(39) &amp; strWorkID &amp; Chr(39) &amp; ";"
1
     Debug.Print "SQL for " &amp; strQuery &amp; ": " &amp; strSQL
1
     lngCount = CreateAndTestQuery(strQuery, strSQL)
1
     Debug.Print lngCount &amp; " records for Work ID " &amp; strWorkID
1
 
1
     Set rstTime = CurrentDb.OpenRecordset(strQuery)
1
 
1
     Do While Not rstTime.EOF
1
<strong><em>         'Copy data to tblTimeSheetTemp</em></strong>
1
 
1
         lngProjectID = Nz(rstTime![ProjectID])
1
         lngAdminID = Nz(rstTime![AdminID])
1
         rstTemp![EmployeeID] = rstTime![EmployeeID]
1
 
1
         If lngProjectID &lt;&gt; 0 Then
1
           rstTemp![ProjectID] = lngProjectID
1
           rstTemp![WorkTypeID] = "P-" &amp; CStr(lngProjectID)
1
         End If
1
 
1
         If lngAdminID &lt;&gt; 0 Then
1
           rstTemp![AdminID] = lngAdminID
1
           rstTemp![WorkTypeID] = "A-" &amp; CStr(lngAdminID)
1
         End If
1
 
1
         intWeekday = Weekday(rstTime![WorkDate])
1
 
1
         Select Case intWeekday
1
 
1
           Case 1
1
               rstTemp![SundayWorkDate] = rstTime![WorkDate]
1
               rstTemp![SundayWorkHours] = rstTime![WorkHours]
1
 
1
           Case 2
1
               rstTemp![MondayWorkDate] = rstTime![WorkDate]
1
               rstTemp![MondayWorkHours] = rstTime![WorkHours]
1
 
1
         Case 3
1
               rstTemp![TuesdayWorkDate] = rstTime![WorkDate]
1
               rstTemp![TuesdayWorkHours] = rstTime![WorkHours]
1
 
1
           Case 4
1
               rstTemp![WednesdayWorkDate] = rstTime![WorkDate]
1
               rstTemp![WednesdayWorkHours] = rstTime![WorkHours]
1
 
1
           Case 5
1
               rstTemp![ThursdayWorkDate] = rstTime![WorkDate]
1
               rstTemp![ThursdayWorkHours] = rstTime![WorkHours]
1
 
1
           Case 6
1
               rstTemp![FridayWorkDate] = rstTime![WorkDate]
1
               rstTemp![FridayWorkHours] = rstTime![WorkHours]
1
 
1
           Case 7
1
               rstTemp![SaturdayWorkDate] = rstTime![WorkDate]
1
               rstTemp![SaturdayWorkHours] = rstTime![WorkHours]
1
 
1
         End Select
1
 
1
         rstTemp![WorkDescription] = rstTime![WorkDescription]
1
         rstTemp![PayRate] = rstTime![PayRate]
1
         rstTime.MoveNext
1
     Loop
1
 
1
     rstTemp.Update
1
     rstWorkIDs.MoveNext
1
   Loop
1
 
1
ErrorHandlerExit:
1
   Exit Sub
1
 
1
ErrorHandler:
1
   If Err.Number = 3021 Then
1
     GoTo ErrorHandlerExit
1
   Else
1
     MsgBox "Error No: " &amp; Err.Number _
1
         &amp; " in GetTimesheetData procedure; " _
1
         &amp; "Description: " &amp; Err.Description
1
   Resume ErrorHandlerExit
1
   End If
1
 
1
End Sub
1
 

References

The code in the sample database needs the following references (in addition to the default references):

Microsoft Word 14.0 Object Library (for SortDeclarations procedure only)

Microsoft Forms 2.0 Object Library (for SortDeclarations procedure only)

If you import code or objects into a database of your own, you may need to set one or more of these references. The version number may differ, depending on your Office version; check the version you have. References are set in the References dialog, opened from the VBA window. For more information on working with references, see Access Archon #107, Working with References.

Supporting Files

The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site, as accarch242.zip, which is the last entry in the table of Access Archon columns for Access Watch.

Document Name Document Type Place in
Advanced Timesheet (AA 242).accdb Access 2007-2010 database (can also be used in higher versions of Access) Wherever you want

Want More?

Office Watch has the latest news and tips about Microsoft Office.  Delivered once a week.