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:
Figure 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 |
