Looping through Recordsets with multiple outcomes

[RSC]

Hello,
I’ve been working on a project and I need a little help. I have 3 tables; tblProjects, tblTesting, and tblEmployees. The issue I’m having is that I’ve created a form which collects testing information from testers that test a particular project. Each project can have multiple testers. tblProject and tblTesters have a one to many relationship and the form (frmTesting) consists of a main form for project info and a subfrom for testing info. For each project tested there are 4 possible outcomes. 1st not all testers have tested to project and that case project status is “InTesting”, 2nd all testers pass testing in that case project staus is “Waiting Final Approval”, 3rd all testers fail testing in that case project status is “Maintenance” and last some testers pass and some fail in that case project status is “IPR”. Here is my code for a button I’ve placed on the sub form.
Private Sub BtnTest_Click()
Dim db As DAO.Database
Dim rsSQL As DAO.Recordset
Dim intMax As Integer
Dim strSQL As String
Dim csSQL As String

Set db = CurrentDb()
strSQL = "SELECT * FROM Testing WHERE Testing.ProjNum ='" & ProjNbr_Txtbox & "'"
Set rsSQL = db.OpenRecordset(strSQL, dbOpenSnapshot)
intMax = rsSQL.RecordCount
rsSQL.MoveFirst
For intX = 1 To intMax
If Testing.TestCompleted_Date Is Null Then
Exit Sub ‘Not all testers have tested project status is already In Testing
End If
rsSQL.MoveNext
Next

rsSQL.MoveFirst
Do While Not rsSQL.EOF
For intY = 1 To intMax
If Me.Pass = False Then
Wend
End If
rsSQL.MoveNext
Next
DoCmd.SetWarnings False
csSQL = "UPDATE tblProjects SET [Status] = Waiting Final Approval ' WHERE [ProjectNumber] =" & ProjNbr_Txtbox & ""
DoCmd.SetWarnings True
Loop


rsSQL.MoveFirst
For intZ = 1 To intMax
If Me.Pass = True Then
DoCmd.SetWarnings False
csSQL = "UPDATE tblProjects SET [Status] = 'IPR' WHERE [ProjectNumber] =" & ProjNbr_Txtbox & ""
DoCmd.SetWarnings True
Exit For
End If
rsSQL.MoveNext
DoCmd.SetWarnings False
csSQL = “UPDATE tblProjects SET [Status] = 'Maintenance' WHERE [ProjectNumber] =" & ProjNbr_Txtbox & ""
DoCmd.SetWarnings True
Next

End Sub

My select statement for my recordset isn't working and I've tested it by putting a specific project number in the statement and I still only pulling one recordset. Any help would be greatly appreciated. Plus I’m not sure my loops are the most effient, could use some help with those too. Thanks Randy

 

[MarkK]

Hello, and welcome to the forums

There are a number of issues.

One is that I would not store the status, I would always calculate it. Some data can change over time. Observe the difference between storing someone's age, and storing their birth date. One of those is subject to change. One of those can always be stored, while the other should always be calculated.

So look at your system, and store only what is not subject to change, then calculate what is left. So store your testers Pass/Fail in respect to a project, but calculate--and never store--the status of a project.

Now, your first status is to test if all testers results are in. So how do we determine, in respect to a project, how many testers results constitute ALL. Then we compare ALL with our current count, and that is the only hard one. The others we'll simply count the passes and fails, and we don't need loops for that.

So how do we figure out how many ALL testers is, in respect to a project?

Also, as an aside, your code is much more readable if you put it in code tags. On busier days I won't even look at code that isn't tagged on here. To highlight your code: hit the number sign on the tool bar, above, and you get a result like . . .

Private Sub cmd123_Click()
   Do While CodeIsTagged
      Debug.Print "See how indents and proportial spacing "
      Debug.Print "makes your code so much easier to read?"
      Debug.Print "==============================="
   Loop
End Sub

How many testers is ALL? How do we figure that out? Surely we can't count all the testers in the table, since you might have staffing changes, or testers away on holiday. Does a project contain a list of testers? You might need a new tblProjectTester table to store that info, so that at the start of a project we can define who will be on the testing team.

 

[RSC]

Thanks for getting back to me and sorry about the code tags. Rookie mistake. I understand about storing calculated data, but I have to work with what I was given, perhaps a project for another time. As far as the number of testers is concerned, it varies by project and each project is assigned specific testers which are stored in tblTesting.Tester field

IDProjNumTesterTest_DatePass6814-0021Karen Thomsen10-Apr-14TRUE6914-0021Kathryn Moore09-Apr-14TRUE7014-0021Sharon Mott01-Apr-14TRUE7114-0021Philip Johnson07-Apr-14TRUE7613-3331Karen Thomsen07-Apr-14TRUE7713-3331Kathryn Moore09-Apr-14TRUE7813-3331Sharon Mott 7914-0023Karen Thomsen07-Apr-14TRUE8114-0023Scott Brand 8214-0023Philip Johnson22-Apr-14TRUE

For example

[COLOR=black][FONT=Verdana]Private Sub BtnTest_Click()[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Dim db As DAO.Database[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Dim rsSQL As DAO.Recordset[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Dim intMax As Integer[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Dim strSQL As String[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Dim csSQL As String[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] [/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Set db = CurrentDb()[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] strSQL = "SELECT * FROM tblTesting WHERE tblTesting.ProjNum ='" & ProjNbr_Txtbox & "'"[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] Set rsSQL = db.OpenRecordset(strSQL, dbOpenSnapshot)[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] intMax = rsSQL.RecordCount[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]rsSQL.MoveFirst[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]For intX = 1 To intMax[/FONT][/COLOR]
[FONT=Verdana]   If tblTesting.TestCompleted_Date Is Null Then[COLOR=#e36c0a][/COLOR][/FONT]
[COLOR=black][FONT=Verdana]      Exit Sub ‘Not all testers have tested project status is already Testing[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]   End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]rsSQL.MoveNext[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Next[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] [/FONT][/COLOR]
[COLOR=black][FONT=Verdana]rsSQL.MoveFirst[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Do While Not rsSQL.EOF[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]   For intY = 1 To intMax[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      If Me.Pass = False Then[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]         Wend[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]   rsSQL.MoveNext[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]   Next[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]DoCmd.SetWarnings False[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]csSQL = "UPDATE tblProjects SET [Status] = [/FONT][/COLOR][FONT=Calibri][SIZE=3]Waiting Final Approval[/SIZE][/FONT][COLOR=black][FONT=Verdana] ' WHERE [ProjectNumber]  =" & ProjNbr_Txtbox & ""[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]DoCmd.SetWarnings True[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Loop[/FONT][/COLOR][COLOR=black][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] [/FONT][/COLOR]
[COLOR=black][FONT=Verdana]rsSQL.MoveFirst[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]For intZ = 1 To intMax[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]   If Me.Pass = True Then[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      DoCmd.SetWarnings False[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      csSQL = "UPDATE tblProjects SET [Status] = 'IPR' WHERE [ProjectNumber] =" & ProjNbr_Txtbox & ""[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      DoCmd.SetWarnings True[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]      Exit For[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]   End If[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]rsSQL.MoveNext[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]DoCmd.SetWarnings False[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]csSQL = “UPDATE tblProjects SET [Status] = 'Maintenance' WHERE [ProjectNumber] =" & ProjNbr_Txtbox & ""[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]DoCmd.SetWarnings True[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Next[/FONT][/COLOR]
[COLOR=black][FONT=Verdana] [/FONT][/COLOR]
[COLOR=black][FONT=Verdana]End Sub[/FONT][/COLOR]

 

[RSC]

Apparently my paste of tblTesting didn’t work.
But it looks like this.
ProjNum Tester
13-3331 Jim
13-3331 Ron
13-3331 Ted
14-0019 Jim
14-0019 Ron
14-0020 Frank
Etc.

 

[MarkK]

Here, consider this code, which just counts things, and then does logic . . .

Function GetStatus(ProjNum As Long) As String
    Dim criteria As String          [COLOR="Green"]'base criteria for data access[/COLOR]
    Dim totalCount As Integer       [COLOR="Green"]'total test count for the project[/COLOR]
    Dim incompleteCount As Integer  [COLOR="Green"]'count of tests where completion date is null[/COLOR]
    Dim passCount As Integer        [COLOR="Green"]'count of tests where passed[/COLOR]
    Dim failCount As Integer        [COLOR="Green"]'count of tests where failed[/COLOR]

[COLOR="Green"]    'get the numbers[/COLOR]
    criteria = "ProjNum = " & ProjNum & " "
    totalCount = GetCount(criteria)
    incompleteCount = GetCount(criteria & "AND CompletionDate Is Null")
    passCount = GetCount(criteria & "AND Pass = True")
    failCount = GetCount(criteria & "AND Pass = False")
    
[COLOR="Green"]    'perform the logic[/COLOR]
    If incompleteCount > 0 Then
        GetStatus = "incomplete"
    ElseIf passCount = totalCount Then
        GetStatus = "total pass"
    ElseIf failCount = totalCount Then
        GetStatus = "total fail"
    Else
        GetStatus = "partial fail"
    End If
   
End Function

Private Function GetCount(criteria As String) As Integer
[COLOR="Green"]'   perform record counts against test table for various criteria
'   this simplifies calling code[/COLOR]
    Const TN As String = "tblTesting"
    GetCount = DCount("*", TN, criteria)
End Function

. . . and you'd be a bit more efficient if you didn't do ALL the counts first, for instance you wouldn't have to do a fail count if you already know it's not complete, so I've structured this code for clarity: there's a DCount() problem, and a logic problem.