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 said:
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
Douglas J. Steele said:
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
(no e-mails, please!)
Stu said:
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.
:
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
(no e-mails, please!)
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