All I really need to know is how to make it where I can make selections in multiple multi-select listboxes, but leave any number of them blank and still have the macro/query work without having to put in an error message about it.
This also includes doing the same with the textboxes. The textboxes would function the same as the listboxes where they would search for anything in a data table to matches what I am looking for in the records and display what I am looking for in a table.
Here is my code
Private Sub Command62_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim District As String
Dim Circumstance As String
Dim Location As String
Dim Method As String
Dim Point As String
Dim Rank As String
Dim strSQL As String
Set db = CurrentDb()
Set qdf = db.QueryDefs("qryMultiselect")
For Each varItem In Me!District.ItemsSelected
District = District & ",'" & Me!District.ItemData(varItem) & "'"
Next varItem
If Len(District) = 0 Then
MsgBox "You did not select anything in the Distrcit field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
District = Right(District, Len(District) - 1)
For Each varItem In Me!Circumstance.ItemsSelected
Circumstance = Circumstance & ",'" & Me!Circumstance.ItemData(varItem) &
"'"
Next varItem
If Len(Circumstance) = 0 Then
MsgBox "You did not select anything in the Circumstance field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Circumstance = Right(Circumstance, Len(Circumstance) - 1)
For Each varItem In Me!Location.ItemsSelected
Location = Location & ",'" & Me!Location.ItemData(varItem) & "'"
Next varItem
If Len(Location) = 0 Then
MsgBox "You did not select anything in the Location field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Location = Right(Location, Len(Location) - 1)
For Each varItem In Me!Method.ItemsSelected
Method = Method & ",'" & Me!Method.ItemData(varItem) & "'"
Next varItem
If Len(Method) = 0 Then
MsgBox "You did not select anything in the Method field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Method = Right(Method, Len(Method) - 1)
For Each varItem In Me!Point.ItemsSelected
Point = Point & ",'" & Me!Point.ItemData(varItem) & "'"
Next varItem
If Len(Point) = 0 Then
MsgBox "You did not select anything in the Point field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Point = Right(Point, Len(Point) - 1)
For Each varItem In Me!Rank.ItemsSelected
Rank = Rank & ",'" & Me!Rank.ItemData(varItem) & "'"
Next varItem
If Len(Rank) = 0 Then
MsgBox "You did not select anything in the Rank field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
Rank = Right(Rank, Len(Rank) - 1)
strSQL = "SELECT * FROM tblDataEntry " & _"WHERE tblDataEntry.District
IN(" & District & ") AND tblDataEntry.Circumstance IN(" & Circumstance &
") AND tblDataEntry.Location IN(" & Location & ") AND tblDataEntry.Method
IN (" & Method & ") AND tblDataEntry.Point IN (" & Point & ") AND
tblDataEntry.Rank IN(" & Rank & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "qryMultiselect"
Set db = Nothing
Set qdf = Nothing
End Sub
I still need to add the textboxes, but I'm not sure where. (Please note that I'm still learning VBA).
Firstly, since you are repeatedly performing the same operation for each form control (in this case, constructing a comma-delimited string from the selected items), you can abstract this operation away into a function, and pass such function each List Box function.
For example, you could define a function such as:
Function SelectedItems(objBox As ListBox) As String
Dim strRtn As String, varItm
For Each varItm In objBox.ItemsSelected
strRtn = strRtn & ",'" & objBox.ItemData(varItm) & "'"
Next varItm
If strRtn <> vbNullString Then SelectedItems = Mid(strRtn, 2)
End Function
Which could then be evaluated with a List Box control argument, and would return either a null string ("") or a comma-delimited string of the selected items in the list box, e.g. something like:
?SelectedItems(Forms!Form1!List1)
'A','B'
Furthermore, since your form controls appear to be named consistently relative to the fields in your table, you could further condense your code to something along the following lines:
Private Sub Command62_Click()
Dim strSQL As String
Dim strArr As String
Dim varItm
For Each varItm In Array("District", "Circumstance", "Location", "Method", "Point", "Rank")
strArr = SelectedItems(Me.Controls(varItm))
If strArr <> vbNullString Then
strSQL = strSQL & "t." & varItm & " in (" & strArr & ") and "
End If
Next varItm
If strSQL <> vbNullString Then strSQL = "where " & Left(strSQL, Len(strSQL) - 5)
With CurrentDb.QueryDefs("qryMultiselect")
.SQL = "select * from tblDataEntry t " & strSQL
End With
DoCmd.OpenQuery "qryMultiselect"
End Sub
Note that the above is entirely untested.
Here, the main for each loop iterates over an array of strings corresponding to the names of your form controls and the names of your table fields.
For each form control in this array, the function obtains a comma-delimited string of the selected items in the control, and concatenates this with the existing SQL code only if one or more items have been selected.
As such, if not items are selected, the field will not feature in the SQL where clause.
If any filter has been selected, the trailing five characters (and) are trimmed from the end of the SQL string, and the where keyword is concatenated to the start of the SQL string - this ensures that if no filter has been selected, the resulting SQL code will not include a where clause.
Finally, the SQL for the query definition is updated and the query is opened, per your original code.
Where textboxes are concerned, the task merely need to skip the call to SelectedItems and obtain the value of the textbox directly.
Here is an example incorporating both listboxes & textboxes:
Private Sub Command62_Click()
Dim strSQL As String
Dim strArr As String
Dim varItm
For Each varItm In Array("District", "Circumstance", "Location", "Method", "Point", "Rank")
strArr = vbNullString
Select Case Me.Controls(varItm).ControlType
Case acListBox
strArr = SelectedItems(Me.Controls(varItm))
Case acTextBox
If Not IsNull(Me.Controls(varItm).Value) Then
strArr = "'" & Me.Controls(varItm).Value & "'"
End If
End Select
If strArr <> vbNullString Then
strSQL = strSQL & "t." & varItm & " in (" & strArr & ") and "
End If
Next varItm
If strSQL <> vbNullString Then strSQL = "where " & Left(strSQL, Len(strSQL) - 5)
With CurrentDb.QueryDefs("qryMultiselect")
.SQL = "select * from tblDataEntry t " & strSQL
End With
DoCmd.OpenQuery "qryMultiselect"
End Sub
I hope this helps, but please note that the above is untested and only theory.