Linking Multiple list boxes to create a query.

[Dustin]

Hello - any help in this department would be greatly appreciated

"I am trying to create a query based on choices made in three
listboxes. The user needs to be able to choose ALL as well as multiple
choices from each listbox. I have used the code below successfully for
one listbox, but am not knowledgeable enough to bring in the other two
listboxes."

Private Sub cmdOpenQuery_Click()

On Error GoTo Err_cmdOpenQuery_Click
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim flgSelectAll As Boolean
Dim varItem As Variant

Set MyDB = CurrentDb()

strSQL = "SELECT * FROM Prospects"

'Build the IN string by looping through the listbox
For i = 0 To LstCity.ListCount - 1
If LstCity.Selected(i) Then
If LstCity.Column(0, i) = "All" Then
flgSelectAll = True
End If
strIN = strIN & "'" & LstCity.Column(0, i) & "',"
End If
Next i

'Test

'Create the WHERE string, and strip off the last comma of the IN
string
strWhere = " WHERE [City] in (" & Left(strIN, Len(strIN) - 1) & ")"

'If "All" was selected in the listbox, don't add the WHERE
condition
If Not flgSelectAll Then
strSQL = strSQL & strWhere
End If


MyDB.QueryDefs.Delete "FilteredProspects"
Set qdef = MyDB.CreateQueryDef("FilteredProspects", strSQL)

'Open the query, built using the IN clause to set the criteria
DoCmd.OpenQuery "FilteredProspects", acViewNormal

'Clear listbox selection after running query
For Each varItem In Me.LstCity.ItemsSelected
Me.LstCity.Selected(varItem) = False
Next varItem

Exit_cmdOpenQuery_Click:
Exit Sub

Err_cmdOpenQuery_Click:

If Err.Number = 5 Then
MsgBox "You must make a selection(s) from the list", ,
"Selection Required !"
Resume Exit_cmdOpenQuery_Click
Else
'Write out the error and exit the sub
MsgBox Err.Description
Resume Exit_cmdOpenQuery_Click
End If

End Sub

 

[Guest]

Doing all three is not much more that doing the one. The only difference
would be where you assign some of the values to the string. For example, you
could put the code to build your strings for each list box in a separate
function and call those from another function that would put it all together:

Function MakeSQL() As String
Dim strWhereAll As String
Dim strWhere As String

strWhereAll = GetListBox1()
strWhere = GetListBox2()
if strWhere <> "" Then
strWhereAll = IIf(strWhereAll = "", strWhere, strWhereAll & " AND " _
& strWhere)
End If
strWhere = GetListBox3()
if strWhere <> "" Then
strWhereAll = IIf(strWhereAll = "", strWhere, strWhereAll & " AND " _
& strWhere)
End If

MakeSQL = "SELECT * FROM Prospects WHERE " & strWhereAll
End Function

The above is over simplified air code, but should give you the idea. The
above example assumes the called functions will return an empty string if no
filtering is chosen for it's list box.

To dress it up a bit, you could make all the GetListBox functions into one
and call them using the control as a reference:

GetListBox(Me.LstBox1)

And this:
if strWhere <> "" Then
strWhereAll = IIf(strWhereAll = "", strWhere, strWhereAll & " AND " _
& strWhere)
End If
could be put into it's own function.

Good Luck

Hello - any help in this department would be greatly appreciated

"I am trying to create a query based on choices made in three
listboxes. The user needs to be able to choose ALL as well as multiple
choices from each listbox. I have used the code below successfully for
one listbox, but am not knowledgeable enough to bring in the other two
listboxes."

Private Sub cmdOpenQuery_Click()

On Error GoTo Err_cmdOpenQuery_Click
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim flgSelectAll As Boolean
Dim varItem As Variant

Set MyDB = CurrentDb()

strSQL = "SELECT * FROM Prospects"

'Build the IN string by looping through the listbox
For i = 0 To LstCity.ListCount - 1
If LstCity.Selected(i) Then
If LstCity.Column(0, i) = "All" Then
flgSelectAll = True
End If
strIN = strIN & "'" & LstCity.Column(0, i) & "',"
End If
Next i

'Test

'Create the WHERE string, and strip off the last comma of the IN
string
strWhere = " WHERE [City] in (" & Left(strIN, Len(strIN) - 1) & ")"

'If "All" was selected in the listbox, don't add the WHERE
condition
If Not flgSelectAll Then
strSQL = strSQL & strWhere
End If


MyDB.QueryDefs.Delete "FilteredProspects"
Set qdef = MyDB.CreateQueryDef("FilteredProspects", strSQL)

'Open the query, built using the IN clause to set the criteria
DoCmd.OpenQuery "FilteredProspects", acViewNormal

'Clear listbox selection after running query
For Each varItem In Me.LstCity.ItemsSelected
Me.LstCity.Selected(varItem) = False
Next varItem

Exit_cmdOpenQuery_Click:
Exit Sub

Err_cmdOpenQuery_Click:

If Err.Number = 5 Then
MsgBox "You must make a selection(s) from the list", ,
"Selection Required !"
Resume Exit_cmdOpenQuery_Click
Else
'Write out the error and exit the sub
MsgBox Err.Description
Resume Exit_cmdOpenQuery_Click
End If

End Sub

 

[Dustin]

Thank you for the reply. I am understanding most of it. But could you
apply this to my code? I am not seeing the big picture. Dustin

 

[Guest]

This is all untested Air Code, but it will hopefully give you some ideas.

Private Sub cmdOpenQuery_Click()

On Error GoTo Err_cmdOpenQuery_Click
Dim MyDB As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim strWhereNext As String

strWhere = GetListBox(Me.lstCity)

strWhereNext = GetListBox(Me.lstSecondList)
strWhere = BuildWhere(strWhere, strWhereNext)

strWhereNext = GetListBox(Me.lstLastList)
strWhere = BuildWhere(strWhere, strWhereNext)

strSQL = "SELECT * FROM Prospects " & _
IIf(strWhere = "", ";", "WHERE " & strWhere & ";")


MyDB.QueryDefs.Delete "FilteredProspects"
Set qdef = MyDB.CreateQueryDef("FilteredProspects", strSQL)

'You have a problem here in that the OpenQuery method is only for Action
Queries
'(MakeTable, Append, Update, Delete) - You query is a Select query
'To use it, it will need to be a recordset

Set MyDB = CurrentDb()
Set rst = MtDB.OpenRecordset(strSQL)

'Clear listbox selection after running query
ClearSelections(Me.lstCity)
ClearSelections(Me.lsSecondList)
ClearSelections(Me.lstLastList)


Exit_cmdOpenQuery_Click:
Exit Sub

Private Function GetListBox(ctl) As String
'Build the IN string by looping through the listbox
Dim varItem As Variant
Dim strIn As String

If ctl.ItemsSelected.Count = 0 Then
StrIn = ""
Else
With ctl
For Each varItem In .ItemsSelected
strIn = strIn & "'" & .ItemData(varItem) & "', "
Next varItem
End With
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = "[City] in (" & Left(strIN, Len(strIN) - 1) & ")"
End If

GetListBox = strIn
End Function

Private Function BuildWhere(strAllIn As String, strNextIn As String) As String

if strAllIn = "" Then
strAllIn = strNextIn
ElseIf strNextIn <> "" Then
strAllIn = strAllIn & " AND " & strNextIn
End If
BuildWhere = strAllIn
End Function

Private Sub ClearSelections(ctl As Contron) As Boolean
Dim varItem As Variant

For Each varItem In ctl
ctl.Selected(varItem) = False
Next varItem

End Function

 

[Dustin]

'Thank you foryour help and time. It seems that I am almost there. I
used your code and changed a few things but an error message is coming
up. I must have an error some where. Could I please use your help,
again?

Private Sub cmdOpenQuery3_Click()

On Error GoTo Err_cmdOpenQuery3_Click
Dim MyDB As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim strWhereNext As String

strWhere = GetListBox(Me.LstCity)

strWhereNext = GetListBox(Me.lstCounty)
strWhere = BuildWhere(strWhere, strWhereNext)

strWhereNext = GetListBox(Me.lstState)
strWhere = BuildWhere(strWhere, strWhereNext)

strSQL = "SELECT * FROM Prospects " & _
IIf(strWhere = "", ";", "WHERE " & strWhere & ";")

MyDB.QueryDefs.Delete "FilteredProspects"
Set qdef = MyDB.CreateQueryDef("FilteredProspects", strSQL)

Set MyDB = CurrentDb()
Set rst = MtDB.OpenRecordset(strSQL)

ClearSelections (Me.LstCity)
ClearSelections (Me.lstCounty)
ClearSelections (Me.lstState)

Exit_cmdOpenQuery3_Click:
Exit Sub

End Sub

Private Function GetListBox(ctl) As String
Dim varItem As Variant
Dim strIn As String

If ctl.ItemsSelected.Count = 0 Then
strIn = ""
Else
With ctl
For Each varItem In .ItemsSelected
strIn = strIn & "'" & .ItemData(varItem) & "', "
Next varItem
End With

'Create the WHERE string, and strip off the last comma of the
IN string
strWhere = "[City] in (" & Left(strIn, Len(strIn) - 1) & ")"
End If

GetListBox = strIn

End Function

Private Function BuildWhere(strAllIn As String, strNextIn As String) As
String

If strAllIn = "" Then
strAllIn = strNextIn
ElseIf strNextIn <> "" Then
strAllIn = strAllIn & " AND " & strNextIn
End If
BuildWhere = strAllIn

End Function

Private Function ClearSelections(ctl As Contron) As Boolean
Dim varItem As Variant

For Each varItem In ctl
ctl.Selected(varItem) = False
Next varItem

End Function