Multiple list selection in search form

[munkee]

Hi everyone,

I am using the following code adapted from Allen Browne:

'Purpose:   This module illustrates how to create a search form, _
            where the user can enter as many or few criteria as they wish, _
            and results are shown one per line.
'Note:      Only records matching ALL of the criteria are returned.
'Author:    Allen Browne ([e-mail]), June 2006.
Option Compare Database
Option Explicit
 
Private Sub cmdFilter_Click()
    'Purpose:   Build up the criteria string form the non-blank search boxes, and apply to the form's Filter.
    'Notes:     1. We tack " AND " on the end of each condition so you can easily add more search boxes; _
                        we remove the trailing " AND " at the end.
    '           2. The date range works like this: _
                        Both dates      = only dates between (both inclusive. _
                        Start date only = all dates from this one onwards; _
                        End date only   = all dates up to (and including this one).
    Dim strWhere As String                  'The criteria string.
    Dim lngLen As Long                      'Length of the criteria string to append to.
    Const conJetDate = "\#mm\/dd\/yyyy\#"   'The format expected for dates in a JET query string.
 
    '***********************************************************************
    'Look at each search box, and build up the criteria string from the non-blank ones.
    '***********************************************************************
    'Text field example. Use quotes around the value in the string.
   ' If Not IsNull(Me.txtDepartment) Then
  '      strWhere = strWhere & "([Department] = """ & Me.txtDepartment & """) AND "
   ' End If
 
    'Another text field example. Use Like to find anywhere in the field.
    If Not IsNull(Me.txtRaisedBy) Then
        strWhere = strWhere & "([Raised By] Like ""*" & Me.txtRaisedBy & "*"") AND "
    End If
 
    'Number field example. Do not add the extra quotes.
    If Not IsNull(Me.txtNCCID) Then
        strWhere = strWhere & "([NCC ID Number] = " & Me.txtNCCID & ") AND "
    End If
 
    'Yes/No field and combo example. If combo is blank or contains "ALL", we do nothing.
  '  If Me.txtDepartmemt = -1 Then
    '    strWhere = strWhere & "([Department] = True) AND "
   ' ElseIf Me.txtDepartment = 0 Then
    '    strWhere = strWhere & "([Department] = False) AND "
   ' End If
 
    'Date field example. Use the format string to add the # delimiters and get the right international format.
    If Not IsNull(Me.txtDate) Then
        strWhere = strWhere & "([Date] >= " & Format(Me.txtDate, conJetDate) & ") AND "
    End If
 
    'Another date field example. Use "less than the next day" since this field has times as well as dates.
    'If Not IsNull(Me.txtEndDate) Then   'Less than the next day.
   '     strWhere = strWhere & "([EnteredOn] < " & Format(Me.txtEndDate + 1, conJetDate) & ") AND "
   ' End If
 
    '***********************************************************************
    'Chop off the trailing " AND ", and use the string as the form's Filter.
    '***********************************************************************
    'See if the string has more than 5 characters (a trailng " AND ") to remove.
    lngLen = Len(strWhere) - 5
    If lngLen <= 0 Then     'Nah: there was nothing in the string.
        MsgBox "No criteria", vbInformation, "Nothing to do."
    Else                    'Yep: there is something there, so remove the " AND " at the end.
        strWhere = Left$(strWhere, lngLen)
        'For debugging, remove the leading quote on the next line. Prints to Immediate Window (Ctrl+G).
        'Debug.Print strWhere
 
        'Finally, apply the string as the form's Filter.
        Me.Filter = strWhere
        Me.FilterOn = True
    End If
End Sub
 
Private Sub cmdReset_Click()
    'Purpose:   Clear all the search boxes in the Form Header, and show all records again.
    Dim ctl As Control
 
    'Clear all the controls in the Form Header section.
    For Each ctl In Me.Section(acHeader).Controls
        Select Case ctl.ControlType
        Case acTextBox, acComboBox
            ctl.Value = Null
        Case acCheckBox
            ctl.Value = False
        End Select
    Next
 
    'Remove the form's filter.
    Me.FilterOn = False
End Sub
 
Private Sub Form_BeforeInsert(Cancel As Integer)
    'To avoid problems if the filter returns no records, we did not set its AllowAdditions to No.
    'We prevent new records by cancelling the form's BeforeInsert event instead.
    'The problems are explained at http://allenbrowne.com/bug-06.html
    Cancel = True
    MsgBox "You cannot add new clients to the search form.", vbInformation, "Permission denied."
End Sub
 
Private Sub Form_Open(Cancel As Integer)
    'Remove the single quote from these lines if you want to initially show no records.
    Me.Filter = "(False)"
    Me.FilterOn = True
End Sub

What I am trying to get my head around is how would I code within the filter script to be able to filter based on multiple/single or no selections within a list box I have created.

The list box contains "Departments", so their names. If I select Blading and Projects, I want the filter to only display records for those two departments.

As you can see in the code I have commented out a couple of attempts with no luck and I dont want to be going around in circles for too long without any help.

I have named the list box lstDepartment.

Thanks for any help,

Chris

[Megalog]

@munkee
What's the name of your list box control? Is it bound to a numeric value, or the department text value (are you using a single column, or multiple columns)? What we'll need to do is loop through all the selections and build a big OR string out of them.

[Megalog]

This should work in the script by Allen Browne, place it anywhere in the function where it is building the strWhere string. Make sure the lisbox is set to Extended type (for muliple selections). Replace "lstDeptFilter" & "[Department]" with your list control name and your Department field name.

First column is bound to a text value

'Listbox example.
    If Me.lstDeptFilter.ItemsSelected.Count > 0 Then
        Dim itm As Variant
        Dim strList As String
        For Each itm In Me.lstDeptFilter.ItemsSelected
            If strList = "" Then
                strList = "([Department] = '" & Me.lstDeptFilter.Column(0, itm) & "')"
            Else
                strList = strList & " OR " & "([Department] = '" & Me.lstDeptFilter.Column(0, itm) & "')"
            End If
        Next
        strWhere = strWhere & "(" & strList & ") AND "
    End If

First Column is bound to a numeric value:

'Listbox example.
    If Me.lstDeptFilter.ItemsSelected.Count > 0 Then
        Dim itm As Variant
        Dim strList As String
        For Each itm In Me.lstDeptFilter.ItemsSelected
            If strList = "" Then
                strList = "([Department] = " & Me.lstDeptFilter.Column(0, itm) & ")"
            Else
                strList = strList & " OR " & "([Department] = " & Me.lstDeptFilter.Column(0, itm) & ")"
            End If
        Next
        strWhere = strWhere & "(" & strList & ") AND "
    End If

[munkee]

Thank you for the code Megalog I will try and implement it at work on Monday.

Whilst you are viewing, I have also been trying to clear selections from the list whenever I press the reset button which is situated in the code at this point: Private Sub cmdReset_Click().

What is the convention you use to clear a list box? is it acList or ListBox for my case?

[Megalog]

Updated Reset Code:

Private Sub cmdReset_Click() 
    'Purpose:   Clear all the search boxes in the Form Header, and show all records again. 
    Dim ctl As Control 
 
    'Clear all the controls in the Form Header section. 
    For Each ctl In Me.Section(acHeader).Controls 
        Select Case ctl.ControlType 
        Case acTextBox, acComboBox 
            ctl.Value = Null 
        Case acCheckBox 
            ctl.Value = False 
        Case acListBox
            call ClearList(ctl.Name)
        End Select 
    Next 
 
    'Remove the form's filter. 
    Me.FilterOn = False 
End Sub 

Place this function anywhere, it will clear the listbox when called from the Reset code.

Public Function ClearList(lst As ListBox)
    Dim varItem As Variant
 
    If lst.MultiSelect = 0 Then
        lst = Null
    Else
        For Each varItem In lst.ItemsSelected
            lst.Selected(varItem) = False
        Next
    End If
 
End Function

[munkee]

Appreciate the hard work I will put some feedback up on Monday, Thanks.

[munkee]

Just tried the code and it works like a charm thanks!

[Megalog]

Glad it all worked for you!

Welcome to Bytes!

[orkun]

hi Dears,

I have included Megalog's ocde into the code which I have also taken from Allen Brown, but it brings no records. My list box name is "lst_status" and it should bring records with 2 different status. what am I doing wrong?

'Purpose: Build up the criteria string form the non-blank search boxes, and apply to the form's Filter.

Dim strWhere As String 'The criteria string.
Dim lngLen As Long 'Length of the criteria string to append to.
Dim strReport As String
Const conJetDate = "\#mm\/dd\/yyyy\#" 'The format expected for dates in a JET query string.

strReport = "Incident_Summary_Report_Between_Dates" 'Put your report name in these quotes.

If Not IsNull(Me.txtStartDate) Then
strWhere = strWhere & "([ReportDate] >= " & Format(Me.txtStartDate, conJetDate) & ") AND "
End If

If Not IsNull(Me.txtEndDate) Then
strWhere = strWhere & "([ReportDate] <= " & Format(Me.txtEndDate, conJetDate) & ") AND "
End If

If Not IsNull(Me.txtsapno) Then
strWhere = strWhere & "([SAPNo] Like ""*" & Me.txtsapno & "*"") AND "
End If


If Not IsNull(Me.observation_cbo) Then
strWhere = strWhere & "([Observation] = """ & Me.observation_cbo & """) AND "
End If

'Listbox example.
If Me.lst_status.ItemsSelected.Count > 0 Then
Dim itm As Variant
Dim strList As String
For Each itm In Me.lst_status.ItemsSelected
If strList = "" Then
strList = "([Status] = '" & Me.lst_status.Column(0, itm) & "')"
Else
strList = strList & " OR " & "([Status] = '" & Me.lst_status.Column(0, itm) & "')"
End If
Next
strWhere = strWhere & "(" & strList & ") AND "
End If

lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove the " AND " at the end.
strWhere = Left$(strWhere, lngLen)

If CurrentProject.AllReports(strReport).IsLoaded Then
DoCmd.Close acReport, strReport
End If

DoCmd.OpenReport strReport, acViewPreview, , WhereCondition:=strWhere
DoCmd.Close acForm, "msearch_frm", acSavePrompt
End If