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.

center>


Comments are closed.