Help with loop statement returning correct results

[kfschaefer]

I am attempting to update data in a table comparing the field names of temptable1 to the data in the temptable2.

I have tried several renditions of a Do loop statement and neither return the correct results.

I need to compare the BEMS(EmployeeNo) in both tables. Table1 = Has the fieldNames(Course No), ie. Field1.name =GLW0029,
Field2.name =74735
Field3.name =80808, etc.....
the beginning fields in this table are

UCBEMS, Org, MgrName, EmployeeName, BEMS & PercentCompleteByName,

Hence the for i = 6 to j portion of the code.

Table2 contains fields
BEMS, [Ilp Learning Cd], CompDt FROM qryEmpMgrCourseList from a query1

I need to match the data in [Ilp Learning Cd] with the fieldnames in table1 to insert, CompDt (completionDate)
in each of the appropriate fields in table1.

I know I only need 1 of the Do Loops, or combination of .

So if table1.BEMS =Table2.BEMS then

Do this

Table1.fieldName("GLW0029") = table2.[Ilp Learning Cd].value =GLW0029 then

insert the CompDt = 12/1/2010 into Table1.Fieldname("GLW0029")

Please help me to clean up this code?

Public Sub FillInData()
'On Error GoTo ProcError

'Purpose: Fill-in the Course Completion Dates for each employee record in the temporary linked table (tblZTemp)

Dim rs1 As DAO.Recordset  'Temporary work table: tblZTemp
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 strSQL2 As String

    strSQL = "INSERT INTO Ztempdata ( UCBEMS, Org, MgrName, EmployeeName, BEMS, PercentCompleteByName )" & _
                " SELECT qryEmpMgrCourseList.UCBEMS, qryEmployeeManager.Org, qryEmployeeManager.MgrName," & _
                " qryEmpMgrCourseList.EmployeeName, qryEmpMgrCourseList.BEMS, qryEmpMgrCourseList.Pct" & _
                " FROM qryEmpMgrCourseList INNER JOIN qryEmployeeManager ON" & _
                " qryEmpMgrCourseList.Mgr_OrgNo = qryEmployeeManager.OrgCtr" & _
                " GROUP BY qryEmpMgrCourseList.UCBEMS, qryEmployeeManager.Org, qryEmployeeManager.MgrName," & _
                " qryEmpMgrCourseList.EmployeeName, qryEmpMgrCourseList.BEMS, qryEmpMgrCourseList.Pct"
    CurrentDb.Execute (strSQL)
    If IsTableExist("tblZTemp") Then
        DoCmd.DeleteObject acTable, "tblZTemp"
    End If
    
    strSQL = "SELECT * FROM ztempdata ORDER BY BEMS"
    
    Set rs1 = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
    
    'We subtract 1 because field references are "zero-based".
    j = rs1.Fields.Count - 1
    
    If rs1.RecordCount = 0 Then
      MsgBox "There are no required courses for current employees to process.", vbInformation, "No Records To Process..."
      'GoTo ExitProc
    End If
   
   'List of Employee and Course numbers where New Hire rules apply - Code to insert NH instead of a date
   strSQL2 = "SELECT BEMS, [Ilp Learning Cd], CompDt FROM qryEmpMgrCourseList ORDER BY BEMS, [Ilp Learning Cd]"
 '  Debug.Print strSQL2
   Set rs2 = CurrentDb.OpenRecordset(strSQL2, dbOpenSnapshot)
   
'Check field values in tblZtemp (rs1). This recordset includes a dynamic number of fields.
'The first six fields, fields 0-6, are constant: UCBEMS, Org, MgrName, EmployeeName, BEMS & PercentCompleteByName
   Do Until rs2.EOF
        rs1.MoveFirst
        If rs1.Fields("BEMS") = rs2.Fields("BEMS") Then
            For i = 6 To j
                If rs1(i).Name = rs2("[Ilp Learning Cd]") Then
                    rs1.Edit
                    rs1(i) = rs2.Fields("CompDt")
                    rs1.Update
                    Exit For
                End If
            Next i
        End If
      rs2.MoveNext
     ' Loop
      rs1.MoveNext
   Loop

    Do Until rs1.EOF
        rs2.MoveFirst
            Do Until rs2.EOF
                If rs1("BEMS") = rs2("BEMS") Then
                    For i = 6 To j
                        If rs1(i).Name = rs2("[Ilp Learning Cd]") Then
                            rs1.Edit
                            rs1(i) = rs2.Fields("CompDt")
                            rs1.Update
                            Exit For
                        End If
                    Next i
                End If
            rs2.MoveNext
            Loop
        rs1.MoveNext
    Loop

'ExitProc:
''Cleanup
'   On Error Resume Next
'   rs1.Close: Set rs1 = Nothing
'   rs2.Close: Set rs2 = Nothing
'   Exit Sub
'
'ProcError:
'    If Err.Number = 3021 Then
'       Err.Clear
'       Resume Next
'    Else
'        MsgBox "Error " & Err.Number & ": " & Err.Description, _
'              vbCritical, "Error in procedure FillInData..."
'        Resume Next
'        Resume
'    End If
End Sub

 

[DCrake]

Public Function DataUptakeRevisions()
Dim Rs1 As DAO.Recordset
Dim Rs2 As DAO.Recordset
Dim fName As String

Set Rs1 = CurrentDb.OpenRecordset("Table1")
    Do Until Rs1.EOF
        Set Rs2 = CurrentDb.OpenRecordset("Select * From Table2 Where ID = " & Rs1("ID"))
            If Not Rs2.EOF Then
                Rs2.Edit
                For x = 0 To Rs1.Fields.Count - 1
                    If x > 0 Then
                        fName = Rs1(x).Name
                        For y = 0 To Rs2.Fields.Count - 1
                            If Rs2(y).Name = fName Then
                                If Not IsNull(Rs1(fName)) Then
                                    Rs2(fName) = Rs1(fName)
                                    Exit For
                                End If
                            End If
                        Next y
                    End If
                Next
                Rs2.Update
                Rs2.Close
            End If
        Rs1.MoveNext
    Loop
    Rs1.Close
Set Rs1 = Nothing
Set Rs2 = Nothing

End Function

This code takes 2 tables that contain the same field names but not necessarily in the same order. The first table is the table that holds the new data. The second table contains the old data.

Essentially it opens up tableNew and loops through it 1 record at a time
Then it opens table old using a select based on the the PK in in the new table.
Then using the names collection it loops though each field in the old table till if finda a match then updates the value and exits the for. It does this for every field in the new table.

 

[kfschaefer]

thanks for the post it looks like it is going to work, however, I need to the starting point to skip the first 6 columns of data, since they where previously updated to make the 1st table.

so the following data will already exist in the table to be updated:

UCBEMS, Org, MgrName, EmployeeName, BEMS & PercentCompleteByName

and I need to code to bypass these fields and start with the next column which will be the first course number, ie. GLW0098, etc.

what do I need to do to prevent the code from starting at the first column and skip to column 6 ( allowing for the zero-based column numbering)

Karen

 

[DCrake]

Want you want to do is to create a query based on fields you want to update and use that for you tableNew

 

[kfschaefer]

Please clarify - "create a query based on fields you want to update and use that for you tableNew"

 

[kfschaefer]

Also I need to update the Course(column) with the appropriate Completion Date per employee.

 

[DCrake]

What does the table structure like for both tables, I think that from what you say you have a denormalised structure.

 

[kfschaefer]

I am creating table 1 on the fly based on a standard set of fields and the course Numbers determined by a group by query list of Courses Sorted by Mandatory date, Course Name - this will determine how it will be displayed on the xls.

Function CreateTableDAO_ZTemp()
'Purpose:   Create TEMP table for data from query for export to Excel(Training Matrix)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    
    If IsTableExist("tblZTemp") Then
        DBEngine(0)(0).TableDefs.Delete "tblZTemp"
    End If
 
    'Initialize the Contractor table.
    Set db = CurrentDb()
    Set tdf = db.CreateTableDef("tblZTemp")
    
    'Specify the fields.
    With tdf
        'AutoNumber: Long with the attribute set.
        Set fld = .CreateField("UCBEMS", dbLong)
        .Fields.Append fld
        .Fields.Append .CreateField("Org", dbText, 15)
        .Fields.Append .CreateField("MgrName", dbText, 255)
        .Fields.Append .CreateField("EmployeeName", dbText, 255)
        .Fields.Append .CreateField("BEMS", dbLong)
        .Fields.Append .CreateField("PercentCompleteByName", dbLong)
   
   strSQL2 = "SELECT TL_CourseList.[Ilp Learning Cd]" & _
            " FROM TL_CourseList" & _
            " WHERE (((TL_CourseList.OnXLS) <> 0) And ((TL_CourseList.InActive) <> -1))" & _
            " ORDER BY TL_CourseList.StandardRequiredDt, TL_CourseList.[Ilp Learning Cd]"
   Set rs2 = CurrentDb.OpenRecordset(strSQL2, dbOpenSnapshot)
   
'Check field values in zTempData (rs1). This recordset includes a dynamic number of fields.
'The first four fields, fields 0-4, are constant: UBEMS, Org, MgrName, EmployeeName, BEMS and PercentCompleteByName

        Do Until rs2.EOF
            .Fields.Append .CreateField(rs2.Fields("[Ilp Learning Cd]"), dbText, 255)
            rs2.MoveNext
        Loop
    End With
    db.TableDefs.Append tdf
    'Clean up
    Application.RefreshDatabaseWindow   'Show the changes
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
End Function

Private Sub cmdUpdateData_Click()

On Error GoTo ProcError
    MyString = vbNullString
    With Me.lstUnitChief
        If .ItemsSelected.Count > 0 Then
            For Each i In .ItemsSelected
                MyString = .ItemData(i) & "," & MyString
            Next i
                MyString = Left(MyString, Len(MyString) - 1)
      End If
    End With
    strSQL = "SELECT *" & _
            " FROM qryEmpMgrCourseList_temp" & _
            " Where UCBEMS IN(" & MyString & ")"
    
    If QueryExists("qryEmpMgrCourseList") Then
        DoCmd.DeleteObject acQuery, "qryEmpMgrCourseList"
    End If
    Set qdf = CurrentDb.CreateQueryDef("qryEmpMgrCourseList", strSQL)
    
' Inputs:        TableName As String, TemplateName As String
' Dependencies:  clsWorkDB class module
CreateTableDAO_ZTemp

 '  Me.txtHidden.SetFocus
   
'**************ADDED THE FOLLOWING LINES OF CODE FOR YOUR DATABASE
'
'Add all employees who have at least one course marked as "OnXLS=True", by running
'an append query in code, which uses a crosstab query as it's source of data.
'NOTE: Using CurrentDb.Execute suppresses the normal action query warnings.
'   CurrentDb.Execute "qappEmployeeCourses", dbFailOnError
Const conLinkedTableName As String = "zTempData"
Const conTemplateTableName As String = "tblZTemp"

   abc.MakeWorkTable conLinkedTableName, conTemplateTableName
'Now, fill in the Data for all BEMS' Course Complete dates into this temporary work table.
   FillInData

'Now, fill in the "NR" (Not Required) data into this temporary work table.
   FillInNRs
'Now, fill in the "NH" (New Hire) data into this temporary work table.
   FillInNHs
'Now, fill in the "LOA" (Leave of Absences) data into this temporary work table. - Not to be included in final count/percentages
   FillInLOA
    
ExitProc:
   Exit Sub
ProcError:

   Select Case Err.Number
   Case 3011  'Invalid Template
      MsgBox "You must use an existing table or SELECT query as the template.", _
             vbCritical, "Invalid Template..."
   Case Else
      MsgBox "Error " & Err.Number & ": " & Err.Description, _
             vbCritical, "Error in Form_Load event procedure..."
   End Select
   
   Resume ExitProc
   
End Sub

Then I am using the following query: qryEmpMgrCourseList - this returns the list of Employees and which courses they are responsible for and completion dates.

see the screen shots I attached earlier.

I believe this is not an issue of Normalization - it is an issue of placing the data in the correct order for export to Excel - by creating the table on the fly I am setting the order for export to xls.

Thanks for your efforts and input.

Karen