I have a pfunction in updating the data of blank fields in a table that met a certain criteria - the current process is slow
and I am looking for a way to improve the processing time.
What I am attempting to accomplish - I have a list of employees and the training courses they are required to take,
however, not all employees are required to take the same list of courses. My output needs to display all employees (and
employee info) with the column headings = the ever changing list of Training Course Numbers. hence the Crosstab query I am
using to update the temp table of the final results.
My current function compares the required courses for each employee inputs the completion date or leaves blank if not
completed, however, it the employee is not Required to take the course in question, then I need to place a value = "NR" in
the field. It is not as simple as replace all blanks with NR, since some required courses may not have been completed
The big issue is that you need to compare the fieldname to the name of the course to determine if the code needs to replace
the blank value with the NR, Since the crosstab query will determine the name of the column heading. It would be great if
this could be simplified by using a query(s), however, I have had no luck with this method.
See Attached for example of Data from the Table. YELLOW cells = NOT Complete - Blank needs to be NR -
Any and all suggestions is greatly appreciated.
NOTE: "Ilp Learning Cd"(fieldname) = CourseNo
BEMS = EmployeeID (pk)
Public Sub FillInNRs()
On Error GoTo ProcError
'Purpose: Add "NR" (Not Required) for each employee record in the temporary linked table, zTempData,
' where there is no course assignment for this employee (ie. no record in the select query "qryEmpMgrCourseList").
Dim db As DAO.Database
Dim rs1 As DAO.Recordset 'Temporary work table: zTempData
Dim rs2 As DAO.Recordset 'qryEmpMgrCourseList
Dim fld As DAO.Field
Dim i As Integer
Dim j As Integer 'Used to store a count of how many courses are in rs1 (zTempData)
Dim strSQL As String
Dim strSQL1 As String
Set db = CurrentDb()
'Open rs1 (read/write ---> dbOpenDynaset). Note: If zTempData has no records, then we notify user and exit procedure.
strSQL = "SELECT * FROM ztempdata ORDER BY BEMS"
Set rs1 = db.OpenRecordset(strSQL, dbOpenDynaset)
j = rs1.Fields.Count - 1 'We subtract 1 because field references are "zero-based".
If rs1.EOF = True Then
MsgBox "There are no required courses for current employees to process.", vbInformation, "No Records To Process..."
'Open rs2 (read only ---> dbOpenSnapshot)
strSQL1 = "SELECT BEMS, [Ilp Learning Cd] FROM qryEmpMgrCourseList ORDER BY BEMS, [Ilp Learning Cd]"
Set rs2 = db.OpenRecordset(strSQL1, dbOpenSnapshot)
'Check field values in zTempData (rs1). This recordset includes a dynamic number of fields.
'The first four fields, fields 0-4, are constant: Org, MgrName, EmployeeName, BEMS and PercentCompleteByName
Do Until rs1.EOF
For i = 6 To j
If rs1(i).Name rs2("[Ilp Learning Cd]") Then 'Or IsNull(rs1(i).Name) Course is "NR" (Not Required) for this BEMS
rs1(i) = "NR"
'We have reached the end of rs2, so add "NR" to any remaining fields in rs1 before moving on.
If rs2.Fields("BEMS") rs1.Fields("BEMS") Or rs2.EOF Or IsNull(rs2.Fields("Bems")) Then
Do Until i = j
i = i + 1
rs1(i) = "NR"
On Error Resume Next
rs1.Close: Set rs1 = Nothing
rs2.Close: Set rs2 = Nothing
Set db = Nothing
If Err.Number = 3021 Then
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure FillInNRs..."