List Box Issues (1 Viewer)

[Exodus]

I am on Access 2016 64bit.
My VBA is not great but I manage. The code I am working with was done by someone else that is no longer available.

I am having issues with one of my list boxes. I am not sure but it seems as though it is retaining the previous selection in memory and its inconsistent.

This db helps tracks the work flow on batches through their various stages. As a batch moves from one stage to the next it goes from one list box to the next. Part of this process is to run reports filtered by the list boxes selection. As each part of the flow is completed the list boxes are re-queried.
Every now and then this particular list box and maybe others but haven't ran into it yet with the others, still seems to have its selection in memory.

The code does test if there are any items selected, but that is where the problem is. It is passing the test even though there are no selections.

I have tried manually selecting and selecting an remaining items but it still persist. Have tried to clear selections with code as well, re-querying. I am at a loss. Its weird because it seems like its a mix of the current selections and the old because another part of the code errors out due to a null value. Forgot to mention the only thing that clears the error is closing the form and reopening it.

Sorry for rambling I am just trying to explain it all.

Here is the initial calling code that passes the selection count

Private Sub cmdWorkflowSortPassReport_Click()
    Dim varParams(1, 4) As Variant
    varParams(0, 0) = "UploadedtoDims": varParams(1, 0) = "True"
    varParams(0, 1) = "SigCheckComplete": varParams(1, 1) = "True"
    varParams(0, 2) = "DispositionCreated": varParams(1, 2) = "True"
    varParams(0, 3) = "SortPassCompleted": varParams(1, 3) = "False"
    varParams(0, 4) = "BatchAuditCompleted": varParams(1, 4) = "False"
    
        If IsNull(Me.AlphaAssign) Then
            MsgBox "Please Select a LetterAssignment"
            ClearList Me.lstReadyForSortPass
            Exit Sub
        End If
    If Me.lstReadyForSortPass.ItemsSelected.Count = 0 Then
        MsgBox "Error, must select at least one batch", vbOKOnly + vbInformation, "Error, Select at least one batch"
    Else
        OpenReportFiltered , "QryBatchManagementListBoxSortPass", "Ready for Sort Pass Report", "lstReadyForSortPass", varParams
        Me.AlphaAssign.Requery
        Me.UsedAlphas.Requery
        RequeryListBoxes
        Me.AlphaAssign = Null
    End If
End Sub

Here is the code that fails because null values, its the red selection

Private Sub OpenReportFiltered(Optional strReportName As String = "RptBatchManagement", _
Optional strQueryName As String = "QryBatchManagement", Optional strReportTitle As String = "Batch Management Report", _
Optional strListBoxName As String = "", Optional varParams As Variant = Null)
    Dim LResponse As Long
    Dim db As Dao.Database: Set db = CurrentDb()
    Dim qdf As QueryDef: Set qdf = db.QueryDefs(strQueryName)
    Dim qdfnew As Dao.QueryDef
    If strQueryName = "QryBatchManagementChallenged" Then
        Set qdfnew = db.QueryDefs(strQueryName & "Filtered")
    Else
        Set qdfnew = db.QueryDefs(strQueryName)
    End If
    Dim rst As Dao.Recordset, rstsub As Dao.Recordset
    Dim strOrigSQL As String: strOrigSQL = qdf.Sql: qdfnew.Sql = qdf.Sql
    Dim ctl As Control
    Dim strSQLLeft As String, strSQLRight As String, strSQL As String
    Dim iCharPos As Integer, i As Integer, j As Integer
    Dim strVariable As String, strParameter As String
    Dim bBatchAuditReport As Integer
    Dim strLeft As String, strRight As String, strItem As String, strItems As String
    Dim lBatchNumber As Long
    Dim prm As Dao.Parameter
    If strReportName = "RptBatchAudit" Or strReportName = "RptBatchAuditByBatch" Then bBatchAuditReport = True
    
    If Not IsNull(strListBoxName) Then
        Set ctl = Me.Controls(strListBoxName)
    Else
        Set ctl = Nothing
    End If
    Dim varItemSelected As Variant
    Dim strItemSelected As String
    iCharPos = InStr(qdf.Sql, "WHERE ")
    If iCharPos > 0 Then
        'strSQLLeft is SELECT * FROM ...
        'strSQLRight is WHERE ...
        strSQLLeft = Left(qdf.Sql, iCharPos - 1)
        strSQLRight = Right(qdf.Sql, Len(qdf.Sql) - iCharPos + 1 - Len("WHERE "))
        strSQL = strSQLLeft
    End If
    If strListBoxName <> "subQualityControl" Then
        If ctl.ListCount = 0 Then
            MsgBox "Nothing to Report", vbOKOnly + vbInformation, "Nothing to Report"
            Exit Sub
        End If
        strSQL = strSQL & "WHERE "
        If ctl.ItemsSelected.Count > 0 Then
            If bBatchAuditReport Then
                strSQL = strSQL & "Batch IN ("
            Else
                strSQL = strSQL & "BatchNumber IN ("
            End If
            For Each varItemSelected In ctl.ItemsSelected
             [COLOR="Red"] strItemSelected = ctl.ItemData(varItemSelected)[/COLOR]
                If strItemSelected <> "" Then
                    If strListBoxName = "lstChallenged" Then
                        iCharPos = InStr(1, strItemSelected, " ")
                        If iCharPos <> 0 Then
                            strItem = Left(strItemSelected, iCharPos - 1)
                        Else
                            strItem = strItemSelected
                        End If
                    Else
                        strItem = strItemSelected
                    End If
                    strItems = strItem & ", "
                    strSQL = strSQL & strItem & ", "
                    iCharPos = 0
                End If
            Next varItemSelected
            strItems = Left(strItems, Len(strItems) - 2)
            strSQL = Left(strSQL, Len(strSQL) - 2)
            strSQL = strSQL & ") AND "
        End If
    Else
        Set rstsub = Me.subQualityControl.Form.Recordset
        lBatchNumber = rstsub!BatchNumber
        strSQL = strSQL & "WHERE BatchNumber=" & lBatchNumber & " AND "
    End If
    If Not IsNull(varParams) Then
        If UBound(varParams) > 0 Then
            j = UBound(varParams, 1)
            If j <> 1 Then
                Debug.Print "Expected 2 Params, got " & j
            End If
            If Not bBatchAuditReport Then strSQL = strSQL & "[BatchType] = ""VALID"" AND "
            For i = 0 To UBound(varParams, 2)
                strVariable = varParams(0, i)
                strParameter = varParams(1, i)
                'Debug.Print strVariable & " = " & strParameter
                strSQL = strSQL & "[" & strVariable & "] = " & strParameter & " AND "
            Next i
            If bBatchAuditReport Then
                strSQL = strSQL & "[election_id] = [TempVars]![EID]"
            Else
                strSQL = strSQL & "[ElectionID] = [TempVars]![EID]"
            End If
        End If
    Else
        If Not bBatchAuditReport Then
            strSQL = strSQL & "[BatchType] = ""VALID"""
        Else
            strSQL = Left(strSQL, Len(strSQL) - Len(" AND"))
        End If
    End If
    'Debug.Print qdf.sql
    qdfnew.Sql = qdf.Sql
    qdfnew.Sql = strSQL
    If strReportName = "RptQualityControl" Then
        For Each prm In qdfnew.Parameters
            prm.Value = Eval(prm.Name)
        Next prm
        Set rst = qdfnew.OpenRecordset(dbOpenDynaset)
        With rst
            .MoveLast
            .MoveFirst
            If .RecordCount > 1 Then
                MsgBox "Error, Please select only one Batch for Quality Control"
                GoTo ExitMe
            End If
            Do Until .EOF
                If !QualityControlReportGenerated Then
                    LResponse = MsgBox("Error, Quality Control Report already generated for batch " & !BatchNumber & " At " & CStr(!QualityControlReportGeneratedDate) & vbCrLf & "Generate Report again?", vbCritical + vbYesNo, "Error, Quality Control Report already generated")
                    If LResponse = vbNo Then
                        GoTo ExitMe
                    End If
                End If
                .MoveNext
            Loop
            .MoveFirst
            .Edit
            !QualityControlReportGenerated = True
            !QualityControlReportGeneratedDate = Now()
            .Update
        End With
        Set rst = Nothing
    End If
    'Debug.Print strSQL
    Debug.Print Me.AlphaAssign
    If strListBoxName = "lstReadyForSortPass" Then
        If IsNull(Me.AlphaAssign) Then
            MsgBox "Please Select a LetterAssignment"
            GoTo ExitMe
        End If
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "QryUpdateBatchAuditAlphaAssignment"
        DoCmd.OpenQuery "QryUpdateSortPassQue"
        
        DoCmd.SetWarnings True
    End If
    DoCmd.OpenReport ReportName:=strReportName, View:=acViewPreview, OpenArgs:=qdfnew.Name & "," & strReportTitle
    
    
ExitMe:
    qdfnew.Sql = strOrigSQL
    Set rst = Nothing
    Set qdf = Nothing
    Set qdfnew = Nothing
    Set rstsub = Nothing
End Sub

 

[RuralGuy]

Have you tried using Nz()?

 

[arnelgp]

Debug your code. i also notice on one of the If end if, you set ctl to nothing, yet you still use it on the rest of the code.

 

[Exodus]

Using Nz(ctl.ItemData(varItemSelected), "") on the red text, seems to have fixed the issue with null. I will keep an eye on it as I said before its inconsistent.
Running debug never produced any errors

 

[RuralGuy]

Thanks for the update.