1
votes

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).

1

1 Answers

0
votes

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.