Loop not entirely working

[hsingh1981]

Hi all i have this code which checks the pid and chart time and loops through records. It the checks for the right intervention id and if that matches adds the record to the main table. How ever this is not entirely working properly...sometimes it copies the samething for some records.


Could any check and see if i have done this right?

Function LabVar()

'' Loops round the dataset and writes to variables
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
DoCmd.SetWarnings False


Dim db, dbLookup As DAO.Database
Dim rsTables, rsLookup As DAO.Recordset


Set db = CurrentDb()
Set rsTables = db.OpenRecordset("DS Main")
Set dbLookup = CurrentDb()
Set rsLookup = db.OpenRecordset("Q_DischargeSum3", dbOpenDynaset, dbReadOnly)




'START OF LOOP
    rsTables.MoveFirst

    Do While Not rsTables.EOF
    currentpid = rsTables.Fields("PID")
    currentcharttime = rsTables.Fields("CHARTTIME")
   

        
        rsLookup.MoveFirst
        Do Until rsLookup.EOF
            If currentpid = rsLookup.Fields("patientId") And currentcharttime = rsLookup.Fields("ChartTime") Then
                rsTables.Edit
                Select Case rsLookup.Fields("interventionId")
                    
                    
                    'ICU DISCHARGE INFORMATION LETTER
                    Case 730
                    rsTables.Fields("ADMPLAN_Plan") = "" & rsLookup.Fields("valueString")
                    
                    Case 6730
                    rsTables.Fields("DISC_DrugTherapy") = "" & rsLookup.Fields("valueString")
                    
                    

                End Select
                rsTables.Update
            End If
        rsLookup.MoveNext
        Loop
        
    currentpid = rsTables.Fields("PID")
    currentcharttime = rsTables.Fields("CHARTTIME")
    
    
    rsTables.MoveNext
    Loop
  
    rsLookup.Close
    Set rsLookup = Nothing
    Set db = Nothing
    
    rsTables.Close
    Set rsTables = Nothing
    Set db = Nothing
    


End Function

 

[Remou]

Something like:

Function LabVar()

'' Loops round the dataset and writes to variables
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
DoCmd.SetWarnings False


Dim db as DAO.Database ', dbLookup As DAO.Database
'You must define each variable, not just the end 
'of the line 
Dim rsTables As DAO.Recordset, rsLookup As DAO.Recordset


Set db = CurrentDb()
Set rsTables = db.OpenRecordset("DS Main")
'Set dbLookup = CurrentDb()
'Set rsLookup = db.OpenRecordset("Q_DischargeSum3", dbOpenDynaset, dbReadOnly)




'START OF LOOP
    rsTables.MoveFirst

    Do While Not rsTables.EOF
    'currentpid = rsTables.Fields("PID")
    'currentcharttime = rsTables.Fields("CHARTTIME")
   

        strSQL="Select interventionId From Q_DischargeSum3 " _
& "Where patientId=" & rsTables.Fields("PID") _
& " And ChartTime=#" rsTables.Fields("CHARTTIME") & "#"

        rsLookUp=db.Openrecordset(strSQL)
        'rsLookup.MoveFirst
        If Not rsLookup.EOF And Not rsLookUp.Bof Then
          '  If currentpid = rsLookup.Fields("patientId") And currentcharttime = rsLookup.Fields("ChartTime") Then
                rsTables.Edit
                Select Case rsLookup.Fields("interventionId")
                    
                    
                    'ICU DISCHARGE INFORMATION LETTER
                    Case 730
                    rsTables.Fields("ADMPLAN_Plan") = "" & rsLookup.Fields("valueString")
                    
                    Case 6730
                    rsTables.Fields("DISC_DrugTherapy") = "" & rsLookup.Fields("valueString")
                    
                    

                End Select
                rsTables.Update
            End If
        'rsLookup.MoveNext
        'Loop
        
    'currentpid = rsTables.Fields("PID")
    'currentcharttime = rsTables.Fields("CHARTTIME")
    
    
    rsTables.MoveNext
    Loop
  
    rsLookup.Close
    Set rsLookup = Nothing
    Set db = Nothing
    
    rsTables.Close
    Set rsTables = Nothing
    Set db = Nothing
    


End Function

However, it should be easy enough to do the whole thing with an update query, rather than looping through the recordset.