VBA code for multiselect listbox in Access 2007

I need to use a form to pass selection criteria to a query. I found VBA code on a form and modified it to work. I can select one, many, or all products from a list box and pass it to the query. I now want to do the same for two other categories. I want to pass a date range, and a location (using multiselect listbox) to the same query. Problem is, I have basically no knowledge of VBA and am just starting to learn. Please be gentle as this is my first post and as I have said, I'm just starting to learn.

The code that works for selecting the product:


[color=Blue]Option Compare Database

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 tblSampling"

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

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

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

'Clear listbox selection after running query
For Each varItem In Me.lbProduct.ItemsSelected
Me.lbProduct.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
Private Sub cmdClose_Click()
On Error GoTo Err_cmdClose_Click


DoCmd.Close

Exit_cmdClose_Click:
Exit Sub

Err_cmdClose_Click:
MsgBox Err.Description
Resume Exit_cmdClose_Click

End Sub[/color]

I've tried modifying the same code, changing some of the names to select the location. The multiselect box works, but I don't know where to insert it, or how to change the WHERE statement to pass it to the query.

Here's the same code with what I've inserted:

[color=Blue]Option Compare Database

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
Dim strSelectLocation As String
Dim l As Integer


Set MyDB = CurrentDb()

strSQL = "SELECT * FROM tblSampling"

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

[color=Red] 'Build the IN string by looping through the listbox
For l = 0 To lbSelectLocation.ListCount - 1
If lbSelectLocation.Selected(l) Then
If lbSelectionLocation.Column(0, l) = "All" Then
figSelectAll = True
End If
strIN = strIN & "'" & lbSelectionLocation.Column(0, l) & "'"
End If
Next l
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE [Prod] in (" & Left(strIN, Len(strIN) - 1) & ")" & " WHERE [SamLoc] in (" & Left(strIN, Len(strIN) - 1) & ")"[/color]

'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 "qryProductSelect"
Set qdef = MyDB.CreateQueryDef("qryProductSelect", strSQL)

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

'Clear listbox selection after running query
For Each varItem In Me.lbProduct.ItemsSelected
Me.lbProduct.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
Private Sub cmdClose_Click()
On Error GoTo Err_cmdClose_Click


DoCmd.Close

Exit_cmdClose_Click:
Exit Sub

Err_cmdClose_Click:
MsgBox Err.Description
Resume Exit_cmdClose_Click

End Sub

Private Sub PageHeaderSection_Click()

End Sub[/color]

It tries to run, but I get a "OBJECT REQUIRED" error message.

Any help you could offer would be greatly appreciated.

Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories