How To Restart A VBA Loop Counter
This is related to an interesting question I received from an individual, and this processing example may help someone.
Basically we are conducting a 10 day clinical study on a group of patients.
We want to store the results of the finding in a database and reset the study counter when a result comes back positive.
So if on “Day 1” the result is “NEG” then we proceed to “Day 2”, and if on “Day 2” the result is “NEG” then we proceed to “Day 3”, and so on for 10 days.
However, if on “Day 9”, the result is “POS”, then we must start the count over from “Day 1”.
This post is going to demonstrate 1 way of coding this.
Here is a shot of the database set up:
…and here is what the form looks like after the “Tally Results” button is clicked:
Notice that whenever the “POS” result is indicated, the test days need to start at 1 again.
Here is the code:
Private Sub btnTallyResults_Click() 'erik@loeblcomservices.com '4/15/19 Dim strSQL As String Dim rstResult As Recordset Dim rstUpdate As Recordset Dim intCounter As Integer 'set up your main update loop based on the current patient ID. Set rstUpdate = CurrentDb.OpenRecordset("tblPatientTesting", dbOpenDynaset) strSQL = "SELECT ptID,ptPatID,ptResults,ptDay FROM tblPatientTesting WHERE ptPatID = " & Me.patID & " ORDER BY ptDate" Set rstResult = CurrentDb.OpenRecordset(strSQL) 'initialize your counter intCounter = 1 'loop the sub data records Do Until rstResult.EOF 'update the ptDay based on the value in the ptResults field If rstResult.Fields("ptResults") = "POS" Then 'reset the counter intCounter = 1 'search for the current record to update rstUpdate.FindFirst "[ptID]=" & rstResult("ptID") 'restart the counter and update the tally count rstUpdate.Edit rstUpdate.Fields("ptDay") = "Day " & intCounter rstUpdate.Update Else 'search for the current record to update rstUpdate.FindFirst "[ptID]=" & rstResult("ptID") 'update the tally count rstUpdate.Edit rstUpdate.Fields("ptDay") = "Day " & intCounter rstUpdate.Update End If 'increment the counter intCounter = intCounter + 1 rstResult.MoveNext Loop 'show the updates on the screen DoCmd.RunCommand acCmdRefresh rstResult.Close Set rstResult = Nothing rstUpdate.Close Set rstUpdate = Nothing End Sub
Watch how I do it:
Let me know if you have questions regarding this.