Advanced Timesheet with Access

Office for Mere Mortals
Your beginners guide to the secrets of Microsoft Office
Invalid email address
Give it a try. You can unsubscribe at any time.

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).

Public Sub WriteTimesheetData()

'Writes newly created or modified data from temp table to tblTimeSheetData

 

On Error GoTo ErrorHandler

 

   Set rstTime = CurrentDb.OpenRecordset("tblTimeSheetData", _

     dbOpenDynaset)

   Set rstTemp = CurrentDb.OpenRecordset("tblTimeSheetDataTemp")

 

   'Clear old records

   DoCmd.SetWarnings False

   DoCmd.OpenQuery "qdelTimePerEmployeeAndWeek"

 

   With rstTemp

     .MoveLast

     .MoveFirst

     lngCount = .RecordCount

     Debug.Print lngCount & " records to write"

 

     If lngCount > 0 Then

         'Create one record in tblTimeSheetData for each weekday

         'that has hours worked

         Do While Not .EOF

           lngEmployeeID = Nz(![EmployeeID])

           curPayRate = Nz(![PayRate])

           lngProjectID = Nz(![ProjectID])

           lngAdminID = Nz(![AdminID])

 

           dblWorkHours = Nz(![MondayWorkHours])

 

           If dblWorkHours > 0 Then

               dteWork = DateAdd("d", -6, _

                 GetProperty("TimesheetWeekEnding", ""))

 

             'Add new record

               rstTime.AddNew

               rstTime![EmployeeID] = ![EmployeeID]

               rstTime![WorkDate] = dteWork

               If lngProjectID <> 0 Then

                 rstTime![ProjectID] = ![ProjectID]

              End If

               If lngAdminID <> 0 Then

                 rstTime![AdminID] = ![AdminID]

               End If

               rstTime![WorkHours] = dblWorkHours

               rstTime![WorkDescription] = ![WorkDescription]

               rstTime![PayRate] = curPayRate

               rstTime.Update

           End If

 

           dblWorkHours = Nz(![TuesdayWorkHours])

 

           If dblWorkHours > 0 Then

               dteWork = DateAdd("d", -5, _

                 GetProperty("TimesheetWeekEnding", ""))

 

               'Add new record

               rstTime.AddNew

               rstTime![EmployeeID] = ![EmployeeID]

               rstTime![WorkDate] = dteWork

               If lngProjectID <> 0 Then

                rstTime![ProjectID] = ![ProjectID]

               End If

               If lngAdminID <> 0 Then

                 rstTime![AdminID] = ![AdminID]

               End If

               rstTime![WorkHours] = dblWorkHours

               rstTime![WorkDescription] = ![WorkDescription]

               rstTime![PayRate] = curPayRate

               rstTime.Update

           End If

 

           dblWorkHours = Nz(![WednesdayWorkHours])

 

           If dblWorkHours > 0 Then

              dteWork = DateAdd("d", -4, _

                 GetProperty("TimesheetWeekEnding", ""))

 

               'Add new record

               rstTime.AddNew

               rstTime![EmployeeID] = ![EmployeeID]

               rstTime![WorkDate] = dteWork

               If lngProjectID <> 0 Then

                 rstTime![ProjectID] = ![ProjectID]

               End If

               If lngAdminID <> 0 Then

                 rstTime![AdminID] = ![AdminID]

               End If

               rstTime![WorkHours] = dblWorkHours

               rstTime![WorkDescription] = ![WorkDescription]

               rstTime![PayRate] = curPayRate

               rstTime.Update

           End If

 

           dblWorkHours = Nz(![ThursdayWorkHours])

 

           If dblWorkHours > 0 Then

               dteWork = DateAdd("d", -3, _

                 GetProperty("TimesheetWeekEnding", ""))

 

               'Add new record

               rstTime.AddNew

               rstTime![EmployeeID] = ![EmployeeID]

               rstTime![WorkDate] = dteWork

               If lngProjectID <> 0 Then

                 rstTime![ProjectID] = ![ProjectID]

               End If

               If lngAdminID <> 0 Then

                 rstTime![AdminID] = ![AdminID]

               End If

               rstTime![WorkHours] = dblWorkHours

               rstTime![WorkDescription] = ![WorkDescription]

               rstTime![PayRate] = curPayRate

               rstTime.Update

           End If

 

           dblWorkHours = Nz(![FridayWorkHours])

 

           If dblWorkHours > 0 Then

               dteWork = DateAdd("d", -2, _

                 GetProperty("TimesheetWeekEnding", ""))

 

               'Add new record

               rstTime.AddNew

               rstTime![EmployeeID] = ![EmployeeID]

               rstTime![WorkDate] = dteWork

               If lngProjectID <> 0 Then

                 rstTime![ProjectID] = ![ProjectID]

               End If

             If lngAdminID <> 0 Then

                 rstTime![AdminID] = ![AdminID]

               End If

               rstTime![WorkHours] = dblWorkHours

               rstTime![WorkDescription] = ![WorkDescription]

               rstTime![PayRate] = curPayRate

             rstTime.Update

           End If

 

           dblWorkHours = Nz(![SaturdayWorkHours])

 

           If dblWorkHours > 0 Then

               dteWork = DateAdd("d", -1, _

                 GetProperty("TimesheetWeekEnding", ""))

 

               'Add new record

               rstTime.AddNew

               rstTime![EmployeeID] = ![EmployeeID]

               rstTime![WorkDate] = dteWork

               If lngProjectID <> 0 Then

                 rstTime![ProjectID] = ![ProjectID]

               End If

               If lngAdminID <> 0 Then

                 rstTime![AdminID] = ![AdminID]

               End If

               rstTime![WorkHours] = dblWorkHours

               rstTime![WorkDescription] = ![WorkDescription]

               rstTime![PayRate] = curPayRate

               rstTime.Update

           End If

 

           dblWorkHours = Nz(![SundayWorkHours])

 

           If dblWorkHours > 0 Then

               dteWork = GetProperty("TimesheetWeekEnding", "")

 

               'Add new record

               rstTime.AddNew

               rstTime![EmployeeID] = ![EmployeeID]

               rstTime![WorkDate] = dteWork

               If lngProjectID <> 0 Then

                rstTime![ProjectID] = ![ProjectID]

               End If

               If lngAdminID <> 0 Then

                 rstTime![AdminID] = ![AdminID]

               End If

               rstTime![WorkHours] = dblWorkHours

               rstTime![WorkDescription] = ![WorkDescription]

               rstTime![PayRate] = curPayRate

               rstTime.Update

           End If

 

           .MoveNext

         Loop

     End If

   End With

 

ErrorHandlerExit:

   Exit Sub

 

ErrorHandler:

   MsgBox "Error No: " & Err.Number _

     & " in WriteTimesheetData procedure; " _

     & "Description: " & Err.Description

   Resume ErrorHandlerExit

 

End Sub

 

Public Sub GetTimesheetData()

'Retrieves a set of records for an employee and a week

'from tblTimeSheetData, and uses them to populate datasheet subform

'which is bound to tblTimeSheetDataTemp

 

On Error GoTo ErrorHandler

 

   Set rstWorkIDs = CurrentDb.OpenRecordset("qryWorkIDsPerEmployeeAndWeek")

   Set rstTemp = CurrentDb.OpenRecordset("tblTimeSheetDataTemp")

 

   strRecordSource = "qryTimePerEmployeeAndWeek"

   strQuery = "qryWorkPerWorkID"

 

   With rstWorkIDs

     .MoveLast

     .MoveFirst

     lngCount = .RecordCount

   End With

 

   Debug.Print lngCount & " Work IDs"

 

   Do While Not rstWorkIDs.EOF

     strWorkID = rstWorkIDs![WorkID]

     rstTemp.AddNew

 

     'Make a filtered query for this WorkID and write data

     'to tblTimeSheetTemp

     strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _

       & "[WorkID] = " & Chr(39) & strWorkID & Chr(39) & ";"

     Debug.Print "SQL for " & strQuery & ": " & strSQL

     lngCount = CreateAndTestQuery(strQuery, strSQL)

     Debug.Print lngCount & " records for Work ID " & strWorkID

 

     Set rstTime = CurrentDb.OpenRecordset(strQuery)

 

     Do While Not rstTime.EOF

         'Copy data to tblTimeSheetTemp

 

         lngProjectID = Nz(rstTime![ProjectID])

         lngAdminID = Nz(rstTime![AdminID])

         rstTemp![EmployeeID] = rstTime![EmployeeID]

 

         If lngProjectID <> 0 Then

           rstTemp![ProjectID] = lngProjectID

           rstTemp![WorkTypeID] = "P-" & CStr(lngProjectID)

         End If

 

         If lngAdminID <> 0 Then

           rstTemp![AdminID] = lngAdminID

           rstTemp![WorkTypeID] = "A-" & CStr(lngAdminID)

         End If

 

         intWeekday = Weekday(rstTime![WorkDate])

 

         Select Case intWeekday

 

           Case 1

               rstTemp![SundayWorkDate] = rstTime![WorkDate]

               rstTemp![SundayWorkHours] = rstTime![WorkHours]

 

           Case 2

               rstTemp![MondayWorkDate] = rstTime![WorkDate]

               rstTemp![MondayWorkHours] = rstTime![WorkHours]

 

         Case 3

               rstTemp![TuesdayWorkDate] = rstTime![WorkDate]

               rstTemp![TuesdayWorkHours] = rstTime![WorkHours]

 

           Case 4

               rstTemp![WednesdayWorkDate] = rstTime![WorkDate]

               rstTemp![WednesdayWorkHours] = rstTime![WorkHours]

 

           Case 5

               rstTemp![ThursdayWorkDate] = rstTime![WorkDate]

               rstTemp![ThursdayWorkHours] = rstTime![WorkHours]

 

           Case 6

               rstTemp![FridayWorkDate] = rstTime![WorkDate]

               rstTemp![FridayWorkHours] = rstTime![WorkHours]

 

           Case 7

               rstTemp![SaturdayWorkDate] = rstTime![WorkDate]

               rstTemp![SaturdayWorkHours] = rstTime![WorkHours]

 

         End Select

 

         rstTemp![WorkDescription] = rstTime![WorkDescription]

         rstTemp![PayRate] = rstTime![PayRate]

         rstTime.MoveNext

     Loop

 

     rstTemp.Update

     rstWorkIDs.MoveNext

   Loop

 

ErrorHandlerExit:

   Exit Sub

 

ErrorHandler:

   If Err.Number = 3021 Then

     GoTo ErrorHandlerExit

   Else

     MsgBox "Error No: " & Err.Number _

         & " in GetTimesheetData procedure; " _

         & "Description: " & Err.Description

   Resume ErrorHandlerExit

   End If

 

End Sub

 

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.