Code for List Boxes

[Stu]

I have a bound form that I am trying to filter records based on selection of
single or multiple rows from single or multiple list boxes. The code works
well with one box only. When I added code for the second list box, no
different results displayed. It obviously doesn't work. Can anyone assist
me where I went wrong and steer me in the right direction?

Private Function SelectListBox(xlstListBox As ListBox) As Long
' *** THIS FUNCTION RETURNS THE NUMBER OF ITEMS SELECTED IN A LISTBOX.

Dim xlngSelected As Long
Dim xvarSelected As Variant

On Error Resume Next

xlngSelected = 0

For Each xvarSelected In xlstListBox.ItemsSelected
xlngSelected = xlngSelected + 1
Next xvarSelected

SelectListBox = xlngSelected
Err.Clear
End Function

Private Function WhereString() As String
Dim strWhere As String
Dim strWhere1 As String
Dim varItem As Variant

On Error Resume Next

strWhere = ""
' ... build "Make" criterion expression
If SelectListBox(Me.lstMake) <> 0 Then
strWhere = strWhere & "Make IN ("
For Each varItem In Me.lstMake.ItemsSelected
strWhere = strWhere & "'" & _
Me.lstMake.ItemData(varItem) & "', "
Next varItem
strWhere = Left(strWhere, Len(strWhere) - Len(", ")) & ") And "
End If

' Strip off the trailing " And " text string
If Len(strWhere) > 0 Then strWhere = Left(strWhere, Len(strWhere) - _
Len(" And "))

' ... build "Model" criterion expression
If SelectListBox(Me.lstModel) <> 0 Then
strWhere1 = strWhere1 & "Model IN ("
For Each varItem In Me.lstModel.ItemsSelected
strWhere1 = strWhere1 & "'" & _
Me.lstModel.ItemData(varItem) & "', "
Next varItem
strWhere1 = Left(strWhere1, Len(strWhere1) - Len(", ")) & ") And "
End If

' Strip off the trailing " And " text string
If Len(strWhere1) > 0 Then strWhere1 = Left(strWhere1, Len(strWhere1) - _
Len(" And "))

WhereString = strWhere
If Len(WhereString) > 0 And Len(strWhere1) > 0 Then
strWhere = strWhere & " AND " & strWhere1
Else
strWhere = strWhere & strWhere1
End If

Exit Function
End Function

Private Sub cmdSearch_Click()
Dim strSQL As String
Dim strRecordSource As String
On Error Resume Next

strRecordSource = "qryModelSearchTEST"

' move focus to clear button
Me.cmdClear.SetFocus

' build sql string for form's RecordSource
strSQL = WhereString
strSQL = "SELECT * FROM " & strRecordSource & _
IIf(strSQL = "", "", " WHERE ") & strSQL & ";"

Me.RecordSource = ""
Me.RecordSource = strSQL

Call SetVisibility(True)

End Sub

Any help is appreciated. Thanks

[Paolo]

Hi Stu,

If you select something just on the second list are the results filtered
correctly?
in the qryModelSearchTEST is the field model available?

HTH Paolo

[Stu]

Both Make and Model (text) are in the grid of qryModelSearchTEST. They are
also the RowSource of each list box. If I select one or more rows only in
the lstModel box, ALL records are retrieved. Any ideas.

[Douglas J. Steele]

Your code could be a lot simpler!

There's no need for the SelectListBox function: the ItemsSelected collection
has a Count property that'll give you that. In the WhereString function, why
bother adding " AND " to the end of strWhere and strWhere1 if the next thing
you do is strip it off? Keep it on both strings, and then if anything was
written to either string, you can strip it off at the end. As well, include
the keyword WHERE in what you return from WhereString, and it'll make
cmdSearch_Click simpler

Private Function WhereString() As String
Dim strWhere As String
Dim strWhere1 As String
Dim varItem As Variant

On Error Resume Next

strWhere = ""
' ... build "Make" criterion expression

If Me.lstMake.ItemsSelected.Count > 0 Then

strWhere = strWhere & "Make IN ("
For Each varItem In Me.lstMake.ItemsSelected
strWhere = strWhere & "'" & _
Me.lstMake.ItemData(varItem) & "', "
Next varItem

strWhere = Left(strWhere, Len(strWhere) - 2) & ") AND "
End If

If Me.lstModel.ItemsSelected.Count > 0 Then

strWhere1 = strWhere1 & "Model IN ("
For Each varItem In Me.lstModel.ItemsSelected
strWhere1 = strWhere1 & "'" & _
Me.lstModel.ItemData(varItem) & "', "
Next varItem

strWhere1 = Left(strWhere1, Len(strWhere1) - 2) & ") AND "
End If

WhereString = strWhere & strWhere1
If Len(WhereString) > 0 Then
WhereString = " WHERE " & Left(WhereString, Len(WhereString) - 5)
End If

End Function

Private Sub cmdSearch_Click()
Dim strSQL As String
Dim strRecordSource As String
On Error Resume Next

strRecordSource = "qryModelSearchTEST"

' move focus to clear button
Me.cmdClear.SetFocus

' build sql string for form's RecordSource

strSQL = "SELECT * FROM " & strRecordSource & _

WhereString()

Me.RecordSource = strSQL

Call SetVisibility(True)

End Sub

That having been said, exactly what's returned by the WhereString function
when you've selected values from the two lists?

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)

"Stu" <S...@discussions.microsoft.com> wrote in message
news:E8581DED-1615-4D8A...@microsoft.com...

[Paolo]

Could you post the SQL of qryModelSearchTEST

[Paolo]

Hullo again,
forget my previous post, I got your error.
Your function returns always the value of strwhere!!
Change those statements

WhereString = strWhere
If Len(WhereString) > 0 And Len(strWhere1) > 0 Then
strWhere = strWhere & " AND " & strWhere1
Else
strWhere = strWhere & strWhere1
End If

with

If Len(strWhere) > 0 And Len(strWhere1) > 0 Then
WhereString = strWhere & " AND " & strWhere1
Else
WhereString = strWhere & strWhere1
End If

Cheers Paolo

[Stu]

Your much simpler code is flawless. Works like a champ. You are an MVP in
my book. Moving forward, I wanted the values in the second list box
displayed to the selection(s) in the first box. I have had success with
combo boxes in doing this, but seem to fail with list boxes and multiple
selections. In combo box I used :
Me.Controls("Model").RowSource = "SELECT DISTINCT
[qryModels].[Model],[qryModels].[Model] FROM [qryModels] WHERE
((([qryModels].[Make])=[forms]![frmModelSearchTEST].[Make])) ORDER BY
[Model]; " This did not work with list boxes. Where might I go from here?
Again, Thank you.

[Douglas J. Steele]

What you've got will work for list boxes where the Multiselect property is
set to None. When you've enabled Multiselect, though, any reference to the
list box simply returns Null, even when only a single entry has been
selected.

You're going to have to use the same sort of logic as you've got elsewhere:

Dim strWhere As String
Dim varSelected As Variant

If Me.Make.ItemsSelected.Count > 0 Then
strWhere = "WHERE [Make] IN ("
For Each varSelected In Me.Make.ItemsSelected
strWhere = strWhere & "'" & Me.Make.ItemData(varSelected & "', "
Next varSelected

strWhere = Left(strWhere, Len(strWhere) - 2) & ") "

End If

Me.Controls("Model").RowSource = "SELECT DISTINCT " & _
"[Model] FROM [qryModels] " & strWhere & _
"ORDER BY [Model]"

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)

"Stu" <S...@discussions.microsoft.com> wrote in message

news:11FBF1D5-C2C1-4D6B...@microsoft.com...

[Stu]

Thank you again for your expertise. I think I am going to set aside this
added feature as I am making it more complex than originally thought. I
tried another idea of adding yet another list box to my form. I encountered
problems as I begin to build up my Where string. I defined strWhere2 and
added at the bottom of code along with code for new lstGroup box. What might
I do to correct the build up of the code. You have taught me a great deal in
your responses. Thanks again.

Private Function WhereString() As String
Dim strWhere As String
Dim strWhere1 As String

Dim strWhere2 As String
Dim varItem As Variant

On Error Resume Next

strWhere = ""
' ... build "Make" criterion expression
If Me.lstMake.ItemsSelected.Count > 0 Then
strWhere = strWhere & "Make IN ("
For Each varItem In Me.lstMake.ItemsSelected
strWhere = strWhere & "'" & _
Me.lstMake.ItemData(varItem) & "', "
Next varItem
strWhere = Left(strWhere, Len(strWhere) - 2) & ") AND "
End If

If Me.lstModel.ItemsSelected.Count > 0 Then
strWhere1 = strWhere1 & "Model IN ("
For Each varItem In Me.lstModel.ItemsSelected
strWhere1 = strWhere1 & "'" & _
Me.lstModel.ItemData(varItem) & "', "
Next varItem
strWhere1 = Left(strWhere1, Len(strWhere1) - 2) & ") AND "
End If

If Me.lstGroup.ItemsSelected.Count > 0 Then
strWhere2 = strWhere2 & "Group IN ("
For Each varItem In Me.lstGroup.ItemsSelected
strWhere2 = strWhere2 & "'" & _
Me.lstGroup.ItemData(varItem) & "', "
Next varItem
strWhere2 = Left(strWhere2, Len(strWhere2) - 2) & ") AND "
End If

WhereString = strWhere & strWhere1 & strWhere2

If Len(WhereString) > 0 Then
WhereString = " WHERE " & Left(WhereString, Len(WhereString) - 5)

End If

End Function

[George Nicholson]

> What might I do to correct the build up of the code.

Here's a generic ListboxSelections-to-SQL routine and examples of use.
Simply pass it the field name and the listbox and it will return a SQL
string that you can then combine with other strings. There are lots of ways
to do this. I hope this points you in a fruitful direction. (For use with
Multi-select listboxes only).

'***mStoreCriteria, mDateCriteria, mKSNoCriteria are all form-level private
string variables

'***In the AfterUpdate events of the appropriate listboxes.
mStoreCriteria = ListboxSelectionsAsSQL(lboStores, "StoreNo", vbLong)
mDateCriteria = ListboxSelectionsAsSQL(lboDates, "ObsvDate", vbDate)
mKSNoCriteria = ListboxSelectionsAsSQL(lboRegisters, "KSNo", vbLong)
'Note: once obtained, these SQL strings could *also* be used to set the
control source of another "dependent" or cascading control. That's why they
are fetched in AfterUpdate.

'*** partial snippet(s) from a Button_Click event that creates the SQL for a
Report.

Select Case mStoreCriteria
Case "", "[StoreNo] Like '*'"
'Do nothing. No filter on this field.
Case Else
mstrCriteria = "(" & mStoreCriteria & ") AND "
End Select

Select Case mDateCriteria
Case "", "[ObsvDate] Like '*'"
'Do nothing. No filter on this field.
Case Else
mstrCriteria = mstrCriteria & "(" & mDateCriteria & ") AND "
End Select

Select Case mKSNoCriteria
Case "", "[KsNo] Like '*'"
'Do nothing. No filter on this field.
Case Else
mstrCriteria = mstrCriteria & "(" & mKSNoCriteria & ") AND "
End Select

If Len(mstrCriteria)=0 Then
' No filters applied.
strSQL = "SELECT yada FROM yada"
Else
' At least one filter. Remove trailing " AND "
strSQL = "SELECT yada FROM yada WHERE (" & Left(mstrCriteria,
Len(mstrCriteria)-5) & ")"
End If
' (do something with strSQL)

'*** in a GENERAL module:
Public Function ListboxSelectionsAsSQL(lbo As ListBox, strFieldName As
String, Optional lngVarType As VbVarType = vbString) As String
On Error GoTo ErrHandler

Dim iSelCount As Integer
Dim strSelection As String
Dim varItem As Variant

strSelection = "" 'Redundant: for clarity

With lbo
' Count the Selections and start to build the SQL string
iSelCount = .ItemsSelected.Count
' Optional: add code to check if "(All)" is a selection. If so,
change iSelCount to 0
Select Case iSelCount
Case 0
' Nothing is selected. Treat as "All" (no filter)
strSelection = strFieldName & " Like '*'"
Case Else
strSelection = strFieldName & " IN ("
For Each varItem In .ItemsSelected
Select Case lngVarType
Case vbInteger, vbLong
strSelection = strSelection &
CLng(.ItemData(varItem))
Case vbString
strSelection = strSelection & "'" &
.ItemData(varItem) & "'"
Case vbDate
strSelection = strSelection & "#" &
CDate(.ItemData(varItem)) & "#"
Case Else
MsgBox "Error in ListboxSelectionAsSQL. " &
Err.Number & " " & Err.Description)
End Select
strSelection = strSelection & ", "
Next varItem
'Remove trailing ", " and add ")"
strSelection = Left(strSelection, Len(strSelection)-2) & ")"
End Select
End With
ListboxSelectionsAsSQL = Trim$(strSelection)
ExitHere:
Exit Function
ErrHandler:
MsgBox "Error in ListboxSelectionAsSQL. " & Err.Number & " " &
Err.Description)
Resume ExitHere
End Function

'***
--
HTH,
George

"Stu" <S...@discussions.microsoft.com> wrote in message

news:864B152D-82F7-46FC...@microsoft.com...

[Stu]

In my code below, I had two list boxes that when used together were building
up the Where string and aorking. I added a third lstGroup kist box, and it
failed at this point.

WhereString = strWhere & strWhere1 & strWhere2
> If Len(WhereString) > 0 Then
> WhereString = " WHERE " & Left(WhereString, Len(WhereString) - 5)

Can you what I did wrong? At &strWhere2 I believe the problem lies ?????

"George Nicholson" wrote:

> ..ItemData(varItem) & "'"

[Stu]

I finally got my code to work with multiple list boxes thanks to your
efforts. I appreciate your extended efforts to help the not so talented
user. I tried using your logic example for filtering selections in a second
list box based on selection in first box. It retrieved an error on the
.ItemsSelected saying Method or Data property not available and the strWhere
statement was entirely red. Is ItemsSelected not available in this case?
Any help appreciated. Thanks again.

[Douglas J. Steele]

You sure you're working with the list box, and not some other control?

Even if the list box doesn't allow Multiselect, the ItemsSelected collection
is still populated and accessible.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele

(no private e-mails, please)

"Stu" <S...@discussions.microsoft.com> wrote in message

news:C9C95FB6-332E-44A1...@microsoft.com...

[Stu]

I cut and pasted your lines of code to the After Update Event of the lstMake
list box. The field Make is the only field in the Row Source of the lstMake
list box when looking at the grid. I compiled and got the message: Compile
Error: Method or data member not found. .ItemsSelected is highlighted at
this point. I also had to add a closing parentheses to strWhere = strWhere &
"'" & Me.Make.ItemData(varSelected & "', ") to make the red highlight go
away. Any further ideas.

[Douglas J. Steele]

You put the closing parenthesis in the wrong place:

strWhere = strWhere & "'" & Me.Make.ItemData(varSelected) & "', "

Sorry about that.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no private e-mails, please)

"Stu" <S...@discussions.microsoft.com> wrote in message

news:F42024D0-1744-42CC...@microsoft.com...

[Stu]

Getting Closer: I realized my error after playing with the code some more. I
got rid of the error messages, but After Update I am getting NO rows
displayed in the lstModel list box. I ran the qryModels on its own and it is
retrieving all records. Not sure where to go now

Dim strWhere As String
>> >> Dim varSelected As Variant
>> >>

>> >> If Me.lstMake.ItemsSelected.Count > 0 Then

>> >> strWhere = "WHERE [Make] IN ("

>> >> For Each varSelected In Me.lstMake.ItemsSelected
>> >> strWhere = strWhere & "'" & Me.lstMake.ItemData(varSelected) & "', "

>> >> Next varSelected
>> >> strWhere = Left(strWhere, Len(strWhere) - 2) & ") "
>> >> End If
>> >>

>> >> Me.Controls("lstModel").RowSource = "SELECT DISTINCT " & _

>> >> "[Model] FROM [qryModels] " & strWhere & _
>> >> "ORDER BY [Model]"

I'm sure the Where string is building correctly, but must have something
wrong in applying to query. Yet, all looks correct.

[Douglas J. Steele]

What's the SQL you're actually generating?

What happens if you run that SQL as a query, rather than putting it as a row
source?

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no private e-mails, please)

"Stu" <S...@discussions.microsoft.com> wrote in message

news:43CB7600-50B9-44CC...@microsoft.com...

[Stu]

BINGO!!!
I removed the Row Source from the lstModel list box and let the query run
through code and it works FLAWLESS. Thanks again for solving a mystery that
has gone on for some time. The MVP of the year for me. Thanks.