Logo
 
Miscellaneous

Loops

# TOPIC CODE NOTES
1
Single Loop
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset ("tblPeople")
rs.MoveFirst 'This says to point (or start) to the first record
Do Until rs.EOF 'This is the loop function
'DO WHAT? begins here...
If rs.Fields ("Gender") = "M" AND rs.Fields ("Location") = "S" Then
CurrentDb.Execute "INSERT into tblPeopleCopy (FullName, Gender,Location) VALUES ( ' " & rs!FullName & " ',' " & rs!Gender & " ',' " & rs!Location & " ');", dbFailOnError
End If
'DO WHAT? ends here...
rs.MoveNext 'This says after the first loop, which record in the recordset do you go to next?
Loop
rs.Close 'Excluding this will have no effect here, but it's always good practice (for other reasons) to have this.
There are two tables, tblPeople (populated) and tblPeopleCopy (empty), with identical structures. This will loop through tblPeople, and any record with a value of 'M' in the [Gender] field, AND 'S' in the [Location] field, will be appended to tblPeopleCopy.
NOTE: In the IF-Statement, I could have used "rs!Gender" instead of "rs.Fields ("Gender")". Note that had I used the "rs!Gender" syntax, I would be using the bang, and not the dot. For some reason in this case, you HAVE TO USE THE BANG.
2
Single Loop

Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tblHistoryUA")
rs.MoveFirst
Do Until rs.EOF

CurrentDb.Execute "UPDATE tblInventory SET DTAssigned = Null" & " WHERE CaseNo = ' " & rs!CaseNo & " ' and CaseType = ' " & rs!CaseType & " ' and PartID = ' " & rs!PartID & " ' ", dbFailOnError
CurrentDb.Execute "UPDATE tblInventory SET DTUnassigned = #" & rs!DtEvent & "#" & " WHERE CaseNo = ' " & rs!CaseNo & " ' and CaseType = ' " & rs!CaseType & " ' and PartID = ' " & rs!PartID & " ' ", dbFailOnError
CurrentDb.Execute "UPDATE tblInventory SET Status = 'Closed' " & " WHERE CaseNo = ' " & rs!CaseNo & " ' and CaseType = ' " & rs!CaseType & " ' and PartID = ' " & rs!PartID & " ' ", dbFailOnError

rs.MoveNext
Loop
rs.Close

In this single-loop procedure, I am looping through tblHistoryUA. For every record in tblHistoryUA, I am UPDATING the corresponding record in tblInventory.
* In short, this UPDATES an external table with values from the current table.
There are no records in tblInventory. I only have this for the example of the code. Also, this could be replaced by using a regular UPDATE query.
3
Single Loop

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Level-IC")
rs.MoveFirst
Do Until rs.EOF

tempST = DLookup("[ST]", "MAIN FORM", "[CaseNo] = '" & rs.Fields("CaseNo") & "'")
tempNoticeDate = DLookup("[Notice Date]", "MAIN FORM", "[CaseNo] = '" & rs.Fields("CaseNo") & "'")

rs.Edit
rs!xST = tempST
rs!xNoticeDate = tempNoticeDate
rs.Update

rs.MoveNext
Loop
MsgBox Now

rs.Close

In this single-loop procedure, I am looping through table "Level-IC". For every record in "Level-IC", I am UPDATING some of the fields with values from a related record in an external table ("MAINFORM") via DLookup.
* In short, this UPDATES the looping table with values from an external table (via DLookup).
4
Single Loop

Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tblHistorySC")
rs.MoveFirst
Do Until rs.EOF

Dim tempSOCPct As Single
Dim tempFullSeverity As Currency
Dim tempAdjSeverity As Currency
varYear = Format(rs!DtEvent, "yyyy")
If (rs!CaseType = "Embezzlement" Or rs!CaseType = "CreditCard" Or rs!CaseType = "IdentityTheft" Or rs!CaseType = "WhiteCollar") Then
tempFullSeverity = DLookup("Severity", "tblSeverity", "[SevYear] = ' " & varYear & " ' And [SevCaseType] = ' " & rs!CaseType & " ' ")
Else
tempFullSeverity = rs!Severity
End If

tempSOCPct = DLookup("PCT", "tblSOC", "[SOC] = '" & rs!SOC & "'")
tempAdjSeverity = tempSOCPct * tempFullSeverity

CurrentDb.Execute "UPDATE tblInventory SET SOCDt = #" & rs!DtEvent & "#" & " WHERE CaseNo = ' " & rs!CaseNo & " ' and CaseType = ' " & rs!CaseType & " ' and PartID = ' " & rs!PartID & " ' ", dbFailOnError
CurrentDb.Execute "UPDATE tblInventory SET SOC = ' " & rs!SOC & " ' " & " WHERE CaseNo = ' " & rs!CaseNo & " ' and CaseType = ' " & rs!CaseType & " ' and PartID = ' " & rs!PartID & " ' ", dbFailOnError
CurrentDb.Execute "UPDATE tblInventory SET HandlingRep = Null" & " WHERE CaseNo = ' " & rs!CaseNo & " ' and CaseType = ' " & rs!CaseType & " ' and PartID = ' " & rs!PartID & " ' ", dbFailOnError
CurrentDb.Execute "UPDATE tblInventory SET Status = 'Closed' " & " WHERE CaseNo = ' " & rs!CaseNo & " ' and CaseType = ' " & rs!CaseType & " ' and PartID = ' " & rs!PartID & " ' ", dbFailOnError
CurrentDb.Execute "UPDATE tblInventory SET Severity = ' " & tempAdjSeverity & " ' " & " WHERE CaseNo = ' " & rs!CaseNo & " ' and CaseType = ' " & rs!CaseType & " ' and PartID = ' " & rs!PartID & " ' ", dbFailOnError

rs.MoveNext
Loop
rs.Close

For a single-loop procedure, this is more complex in that I also used the DLookup function to reference the values in another table, and then used those values to populate my looping table.
NOTE: This is a good example of the syntax to indicate UPDATES to fields that are dates, text, Nulls, constants and numeric.
5
Double Loop

Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Set rs1 = CurrentDb.OpenRecordset("tblFeeder")
Set rs2 = CurrentDb.OpenRecordset("tblHQNames")

'''''OUTER LOOP - Start
rs1.MoveFirst
Do Until rs1.EOF
'''''INNER LOOP - Start
rs2.MoveFirst
Do Until rs2.EOF
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'S''''''''''''''''''''''''''''''''''' THE MATCH CONDITIONS '''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If rs1.Fields("Payee") Like "*" & rs2.Fields("Name1") & "*" And rs1.Fields("Payee") Like "*" & rs2.Fields("Name2") & "*" Then
tempNamesRecNo = rs2.Fields("RecNo")
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'F''''''''''''''''''''''''''''''''''' THE MATCH CONDITIONS '''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rs1.Edit
rs1!NameRec = tempNamesRecNo
rs1.Update

rs2.MoveNext
Loop
'''''INNER LOOP - End
rs1.MoveNext
tempNamesRecNo = ""

Loop
'''''OUTER LOOP - End
rs1.Close
rs2.Close

6
Double Loop
7
Triple Loop

Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset
Set rs1 = CurrentDb.OpenRecordset("tblFeeder")
Set rs2 = CurrentDb.OpenRecordset("tblHQNames")
Set rs3 = CurrentDb.OpenRecordset("tblHQAddress")

'''''OUTER LOOP - Start
rs1.MoveFirst
Do Until rs1.EOF
'''''INNER LOOP (Names) - Start
rs2.MoveFirst
Do Until rs2.EOF

If rs1.Fields("Payee") Like "*" & rs2.Fields("Name1") & "*" And rs1.Fields("Payee") Like "*" & rs2.Fields("Name2") & "*" Then
tempNamesRecNo = rs2.Fields("RecNo")
End If

rs1.Edit
rs1!NameRec = tempNamesRecNo
rs1.Update

rs2.MoveNext
Loop
'''''INNER LOOP (Names) - End

'''''INNER LOOP (Address) - Start
rs3.MoveFirst
Do Until rs3.EOF

If rs1.Fields("Address") Like "*" & rs3.Fields("StreetNo") & "*" And rs1.Fields("Address") Like "*" & rs3.Fields("StreetName") & "*" Then
tempAddressRecNo = rs3.Fields("RecNo")
End If

rs1.Edit
rs1!AddressRec = tempAddressRecNo
rs1.Update

rs3.MoveNext
Loop
'''''INNER LOOP (Address) - End

rs1.MoveNext
tempNamesRecNo = ""
tempAddressRecNo = ""

Loop
'''''OUTER LOOP - End
rs1.Close
rs2.Close

This triple loop is not "a loop in a loop in a loop", but rather "two sequential loops in a loop."