Filtering from a multiselect listbox with other filters (1 Viewer)

[bonzitre]

Hello,
So, I thought I had everything going right, but I was wrong.
I have this form for users to make a custom "report" which is really a datasheet 'ReportF':

The listbox on the right correlates to a column on the table "Patients" which is "PrimaryPillar". The idea is for them to be able to select one or more options and filter the ReportF based on it with the rest of the filtering. What I have so far in code is:

Private Sub cmdRunReport_Click()

    'Check if the report form is open and close it if so
    If CurrentProject.AllForms("ReportF").IsLoaded Then
        DoCmd.Close acForm, "ReportF"
    End If

    ' Column visibility logic
    Dim strVisibleColumns As String

    If Me.ckPrimaryDiag Then strVisibleColumns = strVisibleColumns & "PrimaryDiag, "
    If Me.ckSecondaryDiag Then strVisibleColumns = strVisibleColumns & "SecondaryDiag, "
    If Me.ckDateEntered Then strVisibleColumns = strVisibleColumns & "DateEntered, "
    If Me.ckPrimaryAttending Then strVisibleColumns = strVisibleColumns & "PrimaryAttending, "
    If Me.ckNotes Then strVisibleColumns = strVisibleColumns & "Notes, "
    If Me.ckRequiresPSCFU Then strVisibleColumns = strVisibleColumns & "RequiresFU, "
    If Me.ckReqONNFU Then strVisibleColumns = strVisibleColumns & "ONNFUReq, "
    If Me.ckFirstApptDate Then strVisibleColumns = strVisibleColumns & "FirstApptDate, "
    If Me.ckSurgeryDate Then strVisibleColumns = strVisibleColumns & "SurgeryDate, "
    If Me.ckPrimaryPillar Then strVisibleColumns = strVisibleColumns & "PrimaryPillar, "
    If Me.ckNextFUdate Then strVisibleColumns = strVisibleColumns & "NextFU, "
    If Me.ckPostOp Then strVisibleColumns = strVisibleColumns & "PostOp, "
    If Me.ckPatientNew Then strVisibleColumns = strVisibleColumns & "PatientNew, "
    If Me.ckReasonforFU Then strVisibleColumns = strVisibleColumns & "ReasonforFU, "
    If Me.ckInpatient Then strVisibleColumns = strVisibleColumns & "InPatient, "
    If Me.ckBarriers Then strVisibleColumns = strVisibleColumns & "Barriers, "
    If Me.ckCancerStage Then strVisibleColumns = strVisibleColumns & "CancerStage, "
    If Me.ckdateconfirmdiag Then strVisibleColumns = strVisibleColumns & "DateConfirmDiag, "
    If Me.ckconfdate Then strVisibleColumns = strVisibleColumns & "ConfDate, "
    If Me.ckTreatmentPlan Then strVisibleColumns = strVisibleColumns & "TreatmentPlan, "
    If Me.ckSLCMiscNotes Then strVisibleColumns = strVisibleColumns & "MiscNotes, "
    If Me.ckLungClinicPt Then strVisibleColumns = strVisibleColumns & "LungClinicPt, "
    If Me.ckslctoonncomm Then strVisibleColumns = strVisibleColumns & "SLCtoONNComm, "
    If Me.ckSLCFUDate Then strVisibleColumns = strVisibleColumns & "SLCFUDate, "
    If Me.ckRefandAppt Then strVisibleColumns = strVisibleColumns & "RefandAppt, "
    If Me.ckDOB Then strVisibleColumns = strVisibleColumns & "DOB, "
    If Me.ckSLCtoONNFlag Then strVisibleColumns = strVisibleColumns & "SLCtoONNFlag, "
    If Me.ckPSCFlag Then strVisibleColumns = strVisibleColumns & "PSCFlag, "
    If Me.ckONNtoSLCFlag Then strVisibleColumns = strVisibleColumns & "ONNtoSLCFlag, "
    If Me.ckMedfusion Then strVisibleColumns = strVisibleColumns & "Medfusion, "
    If Me.ckDate1sttreatment Then strVisibleColumns = strVisibleColumns & "Date1stTreat, "
  
                                      
    ' Remove trailing comma and space, if applicable
    If Len(strVisibleColumns) >= 2 Then
        strVisibleColumns = Left(strVisibleColumns, Len(strVisibleColumns) - 2)
    End If

  ' Error handling in case no columns are selected
    If strVisibleColumns = "" Then
        MsgBox "Please select at least one column."
    Exit Sub
  End If

    ' Dynamically set column visibility
    DoCmd.OpenForm "ReportF", acFormDS
    With Forms("ReportF")
        .RecordSource = "DynamicReporting"

        .Controls("PrimaryDiag").ColumnHidden = Not Me.ckPrimaryDiag.Value
        .Controls("SecondaryDiag").ColumnHidden = Not Me.ckSecondaryDiag.Value
        .Controls("DateEntered").ColumnHidden = Not Me.ckDateEntered.Value
        .Controls("PrimaryAttending").ColumnHidden = Not Me.ckPrimaryAttending.Value
        .Controls("Notes").ColumnHidden = Not Me.ckNotes.Value
        .Controls("RequiresFU").ColumnHidden = Not Me.ckRequiresPSCFU.Value
        .Controls("FirstApptDate").ColumnHidden = Not Me.ckFirstApptDate.Value
        .Controls("SurgeryDate").ColumnHidden = Not Me.ckSurgeryDate.Value
        .Controls("PrimaryPillar").ColumnHidden = Not Me.ckPrimaryPillar.Value
        .Controls("NextFU").ColumnHidden = Not Me.ckNextFUdate.Value
        .Controls("PostOp").ColumnHidden = Not Me.ckPostOp.Value
        .Controls("PatientNew").ColumnHidden = Not Me.ckPatientNew.Value
        .Controls("ReasonforFU").ColumnHidden = Not Me.ckReasonforFU.Value
        .Controls("InPatient").ColumnHidden = Not Me.ckInpatient.Value
        .Controls("Barriers").ColumnHidden = Not Me.ckBarriers.Value
        .Controls("CancerStage").ColumnHidden = Not Me.ckCancerStage.Value
        .Controls("DateConfirmDiag").ColumnHidden = Not Me.ckdateconfirmdiag.Value
        .Controls("ConfDate").ColumnHidden = Not Me.ckconfdate.Value
        .Controls("MiscNotes").ColumnHidden = Not Me.ckSLCMiscNotes.Value
        .Controls("LungClinicPt").ColumnHidden = Not Me.ckLungClinicPt.Value
        .Controls("SLCFUDate").ColumnHidden = Not Me.ckSLCFUDate.Value
        .Controls("SLCtoONNComm").ColumnHidden = Not Me.ckslctoonncomm.Value
        .Controls("DOB").ColumnHidden = Not Me.ckDOB.Value
        .Controls("PSCFlag").ColumnHidden = Not Me.ckPSCFlag.Value
        .Controls("ONNtoSLCFlag").ColumnHidden = Not Me.ckONNtoSLCFlag.Value
        .Controls("RefandAppt").ColumnHidden = Not Me.ckRefandAppt.Value
        .Controls("ONNFUReq").ColumnHidden = Not Me.ckReqONNFU.Value
        .Controls("RequiresFU").ColumnHidden = Not Me.ckRequiresPSCFU.Value
        .Controls("SLCtoONNFlag").ColumnHidden = Not Me.ckSLCtoONNFlag.Value
        .Controls("TreatmentPlan").ColumnHidden = Not Me.ckTreatmentPlan.Value
        .Controls("Medfusion").ColumnHidden = Not Me.ckMedfusion.Value
        .Controls("Date1stTreat").ColumnHidden = Not Me.ckDate1sttreatment.Value
      
    End With
  
    ' Filtering logic for [PrimaryPillar] based on multi-select listbox
    Dim selectedSites As String
    Dim i As Long
  
    'listbox filter
    For i = 0 To Me.lstPrimarySite.ItemsSelected.Count - 1
        selectedSites = selectedSites & "'" & Me.lstPrimarySite.ItemData(i) & "', "
    Next i

    If selectedSites <> "" Then
        ' Remove trailing comma and space
        selectedSites = Left(selectedSites, Len(selectedSites) - 2)
    End If

    ' Dynamically set column visibility and filtering
    DoCmd.OpenForm "ReportF", acFormDS
    With Forms("ReportF")
        .RecordSource = "DynamicReporting"

        ' PrimaryPillar Column filtering based off listbox
        .Controls("PrimaryPillar").ColumnHidden = Not Me.ckPrimaryPillar.Value
      
        If selectedSites <> "" Then
            .Filter = "[PrimaryPillar] IN (" & selectedSites & ")"
            .FilterOn = True
        Else
            .Filter = ""
            .FilterOn = False
        End If
      
        ' Filter by checkboxes
        Dim strFilter As String

        If Me.ckSLCtoONNFlag.Value Then
            strFilter = strFilter & "[SLCtoONNFlag] = True"
        End If

        If Me.ckONNtoSLCFlag.Value Then
            If strFilter <> "" Then strFilter = strFilter & " OR "
            strFilter = strFilter & "[ONNtoSLCFlag] = True"
        End If

        If Me.ckPSCFlag.Value Then
            If strFilter <> "" Then strFilter = strFilter & " OR "
            strFilter = strFilter & "[PSCFlag] = True"
        End If

        If Me.ckReqONNFU.Value Then
            If strFilter <> "" Then strFilter = strFilter & " OR "
            strFilter = strFilter & "[ONNFUReq] = True"
        End If
      
        If Me.ckRequiresPSCFU.Value Then
            If strFilter <> "" Then strFilter = strFilter & " OR "
            strFilter = strFilter & "[RequiresFU] = True"
        End If
      
        If Me.ckRequiresPSCFU.Value Then
            If strFilter <> "" Then strFilter = strFilter & " OR "
            strFilter = strFilter & "[RequiresFU] = True"
        End If
              
        If Me.ckPatientNew.Value Then
            If strFilter <> "" Then strFilter = strFilter & " OR "
            strFilter = strFilter & "[PatientNew] = True"
        End If

        If strFilter <> "" Then
            .Filter = strFilter
            .FilterOn = True
        End If

    End With

    DoCmd.OpenForm "ReportF", acFormDS
  
End Sub

Everything works, except the listbox filter. It filters, but not based on the selection but by the number of selections. If I select 1, it only returns breast, if I select 2 it returns breast and genitourinary, et al. It isn't returning the actual selection. What did I mess up? I know it needs to loop but can't figure out the right answer.

 

[bonzitre]

The code for just the listbox portion is:

   ' Filtering logic for [PrimaryPillar] based on multi-select listbox
    Dim selectedSites As String
    Dim i As Long
  
    'listbox filter
    For i = 0 To Me.lstPrimarySite.ItemsSelected.Count - 1
        selectedSites = selectedSites & "'" & Me.lstPrimarySite.ItemData(i) & "', "
    Next i

    If selectedSites <> "" Then
        ' Remove trailing comma and space
        selectedSites = Left(selectedSites, Len(selectedSites) - 2)
    End If

    ' Dynamically set column visibility and filtering
    DoCmd.OpenForm "ReportF", acFormDS
    With Forms("ReportF")
        .RecordSource = "DynamicReporting"

        ' PrimaryPillar Column filtering based off listbox
        .Controls("PrimaryPillar").ColumnHidden = Not Me.ckPrimaryPillar.Value
      
        If selectedSites <> "" Then
            .Filter = "[PrimaryPillar] IN (" & selectedSites & ")"
            .FilterOn = True
        Else
            .Filter = ""
            .FilterOn = False
        End If

 

[MajP]

I use a common module so I never have to write code like you have.

I simply get a filter from a multi value list like this
fltr = GetFilter(Me.lstProducts, ft_Numeric)
I pass in the listbox, and how I want the value delimited 1 "A", #1/1/2024#

Public Enum FieldType
  ft_Text = 0
  ft_Numeric = 1
  ft_Date = 2
  ft_BoundField = 3
  ft_Boolean = 4
End Enum
Public Function GetFilter(TheListBox As Access.ListBox, Optional TheFieldType As FieldType = ft_Text, Optional TheColumn As Integer = -1)
  Dim fltr As String
  Dim I As Long
  Dim val As String
 
  'Provide a column number if not using the bound column
 
  For I = 0 To TheListBox.ItemsSelected.Count - 1
    If TheColumn = -1 Then
      val = TheListBox.ItemData(TheListBox.ItemsSelected(I))
    Else
       val = TheListBox.Column(TheColumn, TheListBox.ItemsSelected(I))
    End If
    Select Case TheFieldType
      Case ft_Text
        val = "'" & Replace(val, "'", "''") & "'"
      Case ft_Date
        val = "#" & Format(CDate(val), "mm/dd/yyyy") & "#"
      Case ft_Boolean
        Select Case val
        Case "Yes", "On", "True"
          val = "-1"
        Case Else
          val = "0"
        End Select
     End Select
     If fltr = "" Then
      fltr = val
    Else
      fltr = fltr & ", " & val
    End If
  Next I
  If fltr <> "" Then
    fltr = " IN (" & fltr & ")"
  End If
  GetFilter = fltr
End Function

 

[bonzitre]

I have very limited know how when it comes to public functions, and when combined with the other code I am having difficulty getting the list box selection to work.

 

[MarkK]

Look at this block of code...

    If Me.ckPrimaryDiag Then strVisibleColumns = strVisibleColumns & "PrimaryDiag, "
    If Me.ckSecondaryDiag Then strVisibleColumns = strVisibleColumns & "SecondaryDiag, "
    If Me.ckDateEntered Then strVisibleColumns = strVisibleColumns & "DateEntered, "
    If Me.ckPrimaryAttending Then strVisibleColumns = strVisibleColumns & "PrimaryAttending, "
    If Me.ckNotes Then strVisibleColumns = strVisibleColumns & "Notes, "
    If Me.ckRequiresPSCFU Then strVisibleColumns = strVisibleColumns & "RequiresFU, "
    If Me.ckReqONNFU Then strVisibleColumns = strVisibleColumns & "ONNFUReq, "
    If Me.ckFirstApptDate Then strVisibleColumns = strVisibleColumns & "FirstApptDate, "
    If Me.ckSurgeryDate Then strVisibleColumns = strVisibleColumns & "SurgeryDate, "
    If Me.ckPrimaryPillar Then strVisibleColumns = strVisibleColumns & "PrimaryPillar, "
    If Me.ckNextFUdate Then strVisibleColumns = strVisibleColumns & "NextFU, "
    If Me.ckPostOp Then strVisibleColumns = strVisibleColumns & "PostOp, "
    If Me.ckPatientNew Then strVisibleColumns = strVisibleColumns & "PatientNew, "
    If Me.ckReasonforFU Then strVisibleColumns = strVisibleColumns & "ReasonforFU, "
    If Me.ckInpatient Then strVisibleColumns = strVisibleColumns & "InPatient, "
    If Me.ckBarriers Then strVisibleColumns = strVisibleColumns & "Barriers, "
    If Me.ckCancerStage Then strVisibleColumns = strVisibleColumns & "CancerStage, "
    If Me.ckdateconfirmdiag Then strVisibleColumns = strVisibleColumns & "DateConfirmDiag, "
    If Me.ckconfdate Then strVisibleColumns = strVisibleColumns & "ConfDate, "
    If Me.ckTreatmentPlan Then strVisibleColumns = strVisibleColumns & "TreatmentPlan, "
    If Me.ckSLCMiscNotes Then strVisibleColumns = strVisibleColumns & "MiscNotes, "
    If Me.ckLungClinicPt Then strVisibleColumns = strVisibleColumns & "LungClinicPt, "
    If Me.ckslctoonncomm Then strVisibleColumns = strVisibleColumns & "SLCtoONNComm, "
    If Me.ckSLCFUDate Then strVisibleColumns = strVisibleColumns & "SLCFUDate, "
    If Me.ckRefandAppt Then strVisibleColumns = strVisibleColumns & "RefandAppt, "
    If Me.ckDOB Then strVisibleColumns = strVisibleColumns & "DOB, "
    If Me.ckSLCtoONNFlag Then strVisibleColumns = strVisibleColumns & "SLCtoONNFlag, "
    If Me.ckPSCFlag Then strVisibleColumns = strVisibleColumns & "PSCFlag, "
    If Me.ckONNtoSLCFlag Then strVisibleColumns = strVisibleColumns & "ONNtoSLCFlag, "
    If Me.ckMedfusion Then strVisibleColumns = strVisibleColumns & "Medfusion, "
    If Me.ckDate1sttreatment Then strVisibleColumns = strVisibleColumns & "Date1stTreat, "

Notice its structure. It is a list of control names, and associated with each control name is a field name. So you could put a block of data like this in a table, and then open a recordset, write a loop, and do all of this work in only a couple of lines.

with currentdb.openrecordset("SELECT MyCtrlName, MyFieldName FROM MyFieldDataTable")
   do while not .eof
       if me.controls("ck" & !MyCtrlName) then visCols = visCols & !MyFieldName & ", "
       .movenext
   loop
end with

When you see repetition in your code, it should start you thinking right away about how you can do it in a loop.

 

[bonzitre]

Look at this block of code...

    If Me.ckPrimaryDiag Then strVisibleColumns = strVisibleColumns & "PrimaryDiag, "
    If Me.ckSecondaryDiag Then strVisibleColumns = strVisibleColumns & "SecondaryDiag, "
    If Me.ckDateEntered Then strVisibleColumns = strVisibleColumns & "DateEntered, "
    If Me.ckPrimaryAttending Then strVisibleColumns = strVisibleColumns & "PrimaryAttending, "
    If Me.ckNotes Then strVisibleColumns = strVisibleColumns & "Notes, "
    If Me.ckRequiresPSCFU Then strVisibleColumns = strVisibleColumns & "RequiresFU, "
    If Me.ckReqONNFU Then strVisibleColumns = strVisibleColumns & "ONNFUReq, "
    If Me.ckFirstApptDate Then strVisibleColumns = strVisibleColumns & "FirstApptDate, "
    If Me.ckSurgeryDate Then strVisibleColumns = strVisibleColumns & "SurgeryDate, "
    If Me.ckPrimaryPillar Then strVisibleColumns = strVisibleColumns & "PrimaryPillar, "
    If Me.ckNextFUdate Then strVisibleColumns = strVisibleColumns & "NextFU, "
    If Me.ckPostOp Then strVisibleColumns = strVisibleColumns & "PostOp, "
    If Me.ckPatientNew Then strVisibleColumns = strVisibleColumns & "PatientNew, "
    If Me.ckReasonforFU Then strVisibleColumns = strVisibleColumns & "ReasonforFU, "
    If Me.ckInpatient Then strVisibleColumns = strVisibleColumns & "InPatient, "
    If Me.ckBarriers Then strVisibleColumns = strVisibleColumns & "Barriers, "
    If Me.ckCancerStage Then strVisibleColumns = strVisibleColumns & "CancerStage, "
    If Me.ckdateconfirmdiag Then strVisibleColumns = strVisibleColumns & "DateConfirmDiag, "
    If Me.ckconfdate Then strVisibleColumns = strVisibleColumns & "ConfDate, "
    If Me.ckTreatmentPlan Then strVisibleColumns = strVisibleColumns & "TreatmentPlan, "
    If Me.ckSLCMiscNotes Then strVisibleColumns = strVisibleColumns & "MiscNotes, "
    If Me.ckLungClinicPt Then strVisibleColumns = strVisibleColumns & "LungClinicPt, "
    If Me.ckslctoonncomm Then strVisibleColumns = strVisibleColumns & "SLCtoONNComm, "
    If Me.ckSLCFUDate Then strVisibleColumns = strVisibleColumns & "SLCFUDate, "
    If Me.ckRefandAppt Then strVisibleColumns = strVisibleColumns & "RefandAppt, "
    If Me.ckDOB Then strVisibleColumns = strVisibleColumns & "DOB, "
    If Me.ckSLCtoONNFlag Then strVisibleColumns = strVisibleColumns & "SLCtoONNFlag, "
    If Me.ckPSCFlag Then strVisibleColumns = strVisibleColumns & "PSCFlag, "
    If Me.ckONNtoSLCFlag Then strVisibleColumns = strVisibleColumns & "ONNtoSLCFlag, "
    If Me.ckMedfusion Then strVisibleColumns = strVisibleColumns & "Medfusion, "
    If Me.ckDate1sttreatment Then strVisibleColumns = strVisibleColumns & "Date1stTreat, "

Notice its structure. It is a list of control names, and associated with each control name is a field name. So you could put a block of data like this in a table, and then open a recordset, write a loop, and do all of this work in only a couple of lines.

with currentdb.openrecordset("SELECT MyCtrlName, MyFieldName FROM MyFieldDataTable")
   do while not .eof
       if me.controls("ck" & !MyCtrlName) then visCols = visCols & !MyFieldName & ", "
       .movenext
   loop
end with

When you see repetition in your code, it should start you thinking right away about how you can do it in a loop.

So that part of the code, while clunky, isn't the issue. It is filtering from the listbox for the selected criteria. It is just filtering in order of top to bottom based on the number selected, not the actual selection itself.