Query Using List Boxes

[Ganz]

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. Are listboxes the best way to do this?

Any help appreciated.

Private Sub Command394_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 REBArchive"

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

'Create the WHERE string, and strip off the last comma of the IN
string
strWhere = " WHERE [IC] 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 "qryMthRebates"
Set qdef = MyDB.CreateQueryDef("qryMthRebates", strSQL)

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

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


Exit_cmdOpenQuery_Click:
Exit Sub

Err_cmdOpenQuery_Click:

If Err.Number = 5 Then
MsgBox "Please make a selection from each 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

 

[Jeff Boyce]

It looks like you are doing your "strWHERE" determination in code behind one
of the listboxes. If you want to incorporate 2 or 3 or more controls,
you'll need to move that code to the form's code module level and create a
function. Then you'd call that function once, perhaps behind a button
click, rather than on each control's selection.

--
Regards

Jeff Boyce
Microsoft Office/Access MVP


Microsoft IT Academy Program Mentor
http://microsoftitacademy.com/

 

[John Spencer]

You've got the basic idea already. I've modified your code a bit but it
should give you the idea
Private Sub Command394_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 REBArchive"

'====================================
' Repeat this code - actually you could break this out
' into a separate function and pass the list and field to
' the function to return you a string to be appended
'====================================
'Build the IN string by looping through the listbox
For i = 0 To lbItemClass.ListCount - 1
If lbItemClass.Selected(i) Then
If lbItemClass.Column(0, i) = " All" Then
flgSelectAll = True
StrIn = vbNullstring '<<<<<<<<<<<<<<
End If
strIN = strIN & "'" & lbItemClass.Column(0, i) & "',"
End If
Next i

' Test StrIn and if it has length then add it to the strWhere clause
IF StrIn <> vbNullString then
strWhere = strWHERE & " [IC] in (" & Left(strIN, Len(strIN) - 1) &
") AND "
END IF

'=====================
' Repeat the section of code above modified for each listbox/field combo
'=====================

If strWhere <> vbNullstring Then
' Add the where chopping off the last " AND " or the last " OR "
' depending on which conjunction you are using with the criteria.
strSQL = strSQL & " WHERE " & Left(strWhere,Len(strIn)-4)
End If

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

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

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


Exit_cmdOpenQuery_Click:
Exit Sub

Err_cmdOpenQuery_Click:

If Err.Number = 5 Then
MsgBox "Please make a selection from each 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