Inefficient Loop

[Yannt]

Hi,

I'm trying to simplify and make this piece of code more efficient (basically would like to remove the 2nd loop); any suggestions?

Thanks
Yann

    Dim db As Database, rst1 As Recordset, rst2 As Recordset, qry1 As String, qry2 As String
    Dim intCurrentProgress As Integer, intTotalWidth As Integer, intProgressBarMax As Integer
 
    q = MsgBox("Are you sure you want to update all ranks?", vbExclamation + vbOKCancel)
    If q = vbCancel Then Exit Function
 
    qry1 = "SELECT DISTINCT tblStudents.StudentID, tblStudents.RankID FROM tblStudents INNER JOIN tblGradingResults ON tblStudents.StudentID = tblGradingResults.StudentID"
 
 
 
    Set db = CurrentDb()
    Set rst1 = db.OpenRecordset("qryLastGradingPerStudent")
    intProgressBarMax = rst1.RecordCount
 
    SysCmd acSysCmdInitMeter, "Updating: ", intProgressBarMax
    If Not rst1.EOF Then
        rst1.MoveFirst
        Do Until rst1.EOF
 
        SysCmd acSysCmdUpdateMeter, intCurrentProgress
 
        qry2 = "SELECT tblStudents.StudentID, tblStudents.RankID, tblStudents.LastGrading FROM tblStudents WHERE (((tblStudents.StudentID)=" & rst1!StudentID & "))"
        Set rst2 = db.OpenRecordset(qry2)
            rst2.Edit
                rst2!RankID = rst1!RankID
                rst2!LastGrading = rst1!GradingDate
                rst2.Update
            rst2.Close
                Set rst2 = Nothing
 
 
            'update Progress Barr
            intCurrentProgress = intCurrentProgress + 1
        rst1.MoveNext
        Loop
    End If
 
    rst1.Close
'    rst2.Close
    Set rst1 = Nothing
    Set rst2 = Nothing
    Set db = Nothing
 
 

[Rabbit]

Is there a reason you're doing it with a recordset instead of using an update query?

[Yannt]

I did, but got an error: "Operation must use and updateable query"; hence why I used the recordset.

[TheSmileyCoder]

The reason it is not updatable is because you are using the keyword Distinct in your SQL, which also leads me to wonder if your data is properly normalised since you feel you need the distinct keyword.


I agree with Rabbit that from what you have presented here, it seems more like something for an update query,but we would need more details on your table design to say anything for sure.

I would still like however to answer your question.
In terms of making your code more efficient, you need to move the second recordset opening out of the loop, and then use rst2.findfirst and rst2.findNext combined with rst2.Nomatch (use the help function to read about the 3 functions) inside the loop.

[Yannt]

Thanks for your answer Smiley. Qry1 is no longer required (I forgot to delete it from the code). The table structure is quite complex and can't be changed at this point of time.

I'm not sure to understand how to use the "find first" and "find Next" option, could you please give me more details?

Thanks

[TheSmileyCoder]

I still need more info on your table structure to give you a proper answer. At best I would be guessing and probably confusing you.

Imagine however a tbl_Orders (with primary Key: PK_Order) and a tbl_OrderDetails (With Foreign Key FK_Order) in which we would want to loop through the orders shipped today, specifying that each item was shipped succesfully.

Dim cDB as dao.Database
Dim rsOrder as Dao.RecordSet
Dim rsOrderDetails as Dao.Recordset
set rsOrder=cDB.OpenRecordset("SELECT tbl_Order.PK_Order Where dt_OrderDate=Date()",dbopendynaset)
Set rsOrderDetails =cdb.OpenRecordset("tbl_OrderDetails",dbOpenDynaset)
 
dim strCriteria as string
Do while not rsOrder.EOF
  strCriteria="FK_Order=" & rsOrder!PK_Order
  rsOrderDetails.FindFirst strCriteria
  Do while NOT rsOrderDetails.Nomatch
    rsOrderDetails.Edit
      rsOrderDetails!b_Shipped=True
    rsOrderDetails.Update
 
    'Move to next match
    rsOrderDetails.FindNext strCriteria
  Loop
Loop
 
 
'Cleanup
set cDb=Nothing
set rsOrder=nothing
set rsOrderDetails=nothing

[Yannt]

FindFirst works like a charm, speed gain is great. Thanks for your help.

Yann