Build Query from Multiple ListBoxes (1 Viewer)

[alsoascientist]

Hi all,

I've seen a number of threads about this but most are pretty old and don't really address what I'm looking for.

I have the code below which generates a string that I pass as SQL to create a query to bring the information into a subform. This works perfectly well, however I am now trying to adapt it for a different form and use just the ListBox part for over 25 different listboxes. I would like to make it as dynamic as possible, and short of writing the same code for every listbox and stringing them together, I've tried just about everything I can think of.

Does anyone have any ideas? Am I trying to be lazy or efficient?!

Private Function BuildFilter() As Variant
'Declarations
Dim varWhere As Variant
Dim varColor As Variant
Dim varItem As Variant
Dim intIndex As Integer
Const conJetDate = "\#mm\/dd\/yyyy\#"   'The format expected for dates in a JET query string.
'Values
select1 = Forms![SearchForm]![Selection1].Value
select2 = Forms![SearchForm]![Selection2].Value
select3 = Forms![SearchForm]![Selection3].Value
'Creates Null Values
varWhere = Null
varColor = Null
'Searches in ComboBoxes
If Me.Search1 > "" Then
varWhere = varWhere & "[" & select1 & "] LIKE ""*" & Me.Search1 & "*"" AND "
End If
'Sets a date range
If Me.Date1 > "" Then
varWhere = varWhere & "[" & select2 & "] >= " & Format(Me.Date1 + 1, conJetDate) & " AND "
End If
If Me.Date2 > "" Then
varWhere = varWhere & "[" & select2 & "] < " & Format(Me.Date2 + 1, conJetDate) & " AND "
End If
'Sets the OR for a ListBox
For Each varItem In Me.ListSelect.ItemsSelected
varColor = varColor & "[" & select3 & "] = """ & Me.ListSelect.ItemData(varItem) & """ OR "
Next
'checks to see if there is a listbox selected
If IsNull(varColor) Then
Else
'Takes off the last OR
If Right(varColor, 4) = " OR " Then
varColor = Left(varColor, Len(varColor) - 4)
End If
'Puts in the parenthesis
varWhere = varWhere & "( " & varColor & " )"
End If
'Checks to see if any selections have been made
If IsNull(varWhere) Then
varWhere = ""
Else
'Adds it all together
varWhere = " WHERE " & varWhere
'Takes off the last AND
If Right(varWhere, 5) = " AND " Then
varWhere = Left(varWhere, Len(varWhere) - 5)
End If
End If
'End Result
BuildFilter = varWhere
End Function

I've been playing around with this too but can't get it working!

For Each ctrl In Me.ReportsForm.Controls
If ctrl.ControlType = acListBox Then
For Each varItem In ctrl.ItemsSelected
varWhere = varWhere & "ctrl.name = """ & ctrl.ItemData(varItem) & """ OR "
Next

 

[spikepl]

"Can't get it working " or "it doen't work" is a signal that you are unhappy, but contains little clues to anything else.

Be specific: what do you want exactly, what does the code do (it always does something!) and what did you expect. If it errors, what line, which message.

How to find out what it does step by step is given in the section How to debug VBA code here: http://www.access-programmers.co.uk/forums/showthread.php?t=149429

 

[smig]

It is possible to use For each ... to create a long SQL Query WHERE_clues string.
But you must build your listboxes very carefully for this to work.

My suggestion is to use columns of your list to hold data to build your query string. this will make your life easiear espacially when it's not the same type of query for all lists.

In your example you search for "Like" in Me.Search1 and search for date format in Me.Date1, Me.Date2

 

[alsoascientist]

Apologies, I should have made this clearer (I've been getting a bit frustrated but yeah... not a very helpful description! Sorry!)

The first code is the one that I am trying to adapt... I don't need the combo and date sections of it at the moment but may do in the future so I have left these in (they will always return "").

The section I am trying to manipulate is the second code that I have updated below(which I think I am getting there with!)

I am running it as a msgbox for now so that I can see what is returned and then can put the section back into the rest of the code.

After playing around with where the ifs and nexts should go, the issue I am having is passing the name of the control to the string - this keeps returning as "ctrl.name" instead of the name of the control.

Private Sub ClearBtn_Click()
Dim varWhere As Variant
Dim varItem As Variant
varWhere = ""
Dim ctrl As Control
Dim RptFrm As Form
Set RptFrm = Forms!ReportsForm
For Each ctrl In RptFrm.Controls
If ctrl.ControlType = acListBox Then
For Each varItem In ctrl.ItemsSelected
varWhere = varWhere & "ctrl.Name = """ & ctrl.ItemData(varItem) & """ Or """""
Next
End If
Next
Dim Text
BuildFil = varWhere
Text = BuildFil
MsgBox Text, vbOKOnly
End Sub

 

[spikepl]

Access does like any other code. Precisely what you told it. Not necessarily what you meant. So if you pass "ctrl.name" and, not so surprisingly, get "ctrl.name" back, then there is a strong clue there

 

[alsoascientist]

Hmmm... you said my post was ambiguous?!

I kind of guessed myself that was where my issue is (as I mentioned in my last comment), however I don't know how to fix it. When I move around the quotations I either get "ctrl.name", false, or Error: Type MisMatch. I don't know how to pass the actual name of the control to the string.

 

[smig]

puting "ctrl.name" inside the quate will send it as a string ctrl.name
if you remove the quate you'll get the name of the control

This how VB and any other code will do

 

[alsoascientist]

Thanks Smig,

I knew that would be the case but I was missing another & before the = (and got rid of the "" at the end) - that's why I was getting the other errors.

I've ended up with this and it works fine - just need to fit it into the rest of the code now

Dim varWhere As Variant
Dim varItem As Variant
varWhere = ""
Dim ctrl As Control
Dim RptFrm As Form
Set RptFrm = Forms!ReportsForm
For Each ctrl In RptFrm.Controls
If ctrl.ControlType = acListBox Then
For Each varItem In ctrl.ItemsSelected
varWhere = varWhere & ctrl.Name & " = """ & ctrl.ItemData(varItem) & """ Or "
Next
End If
Next
Dim Text

 

[smig]

This:
varWhere = varWhere & ctrl.Name & " = """ & ctrl.ItemData(varItem) & """ Or "
can be changed to this:
varWhere = varWhere & ctrl.Name & " = " & ctrl.ItemData(varItem) & " Or "

 

[alsoascientist]

Hmmm... Thought I had it but something is still not right!

varWhere = varWhere & ctrl.Name & " = " & ctrl.ItemData(varItem) & " Or " - gives me a syntax error (missing operator)

varWhere = varWhere & ctrl.Name & " = """ & ctrl.ItemData(varItem) & """ Or " - works without an error but doesnt filter the results

I've also tried
varWhere = varWhere & ctrl.Name & " = '" & ctrl.ItemData(varItem) & "' Or " - again works without an error but doesn't filter the results

as the other two both work but without filtering I think it may be the first that is correct but I can't find the syntax error when I print the variable.

 

[smig]

At the end result you must remove the last OR
The code I wrote should work if you do.
Just in case put another space here:
varWhere & " " & ctrl.Name

Try with one selection and put the string into the debug window (or msgbox) and see if it make sense

 

[alsoascientist]

Ahhh... the trying it with only fixed it for me - the first list it was searching was a number and the rest text - I don't really need to use that one so I've removed it completely and it works a charm now - thanks for you help

If you were interested I ended up with this: (I can't remember if all the dim are part of this as there are other codes in the module)

'-------------------------------------------------------------------------------------------------------------------------------------
'These are the declarations for the option explicit
'-------------------------------------------------------------------------------------------------------------------------------------
Dim i As Long
Dim ctrl As Control
Dim RptFrm As Form
Dim varFiltr As Variant
Dim varWhere As Variant
Dim varItem As Variant
Dim qdf As QueryDef
Dim rept As String
'-------------------------------------------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------------------------------------------
 
'-------------------------------------------------------------------------------------------------------------------------------------
'This will activate the search from the functions below
'-------------------------------------------------------------------------------------------------------------------------------------
Private Sub SearchBtn_Click()
Me.[SearchSubForm].Form.RecordSource = BuildRept & " FROM " & "AllQuery" & BuildFilter
Me.SearchSubForm.Requery
End Sub
'-------------------------------------------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------------------------------------------
 
'-------------------------------------------------------------------------------------------------------------------------------------
'This will build the SELECT FROM section of the SQL Filter
'-------------------------------------------------------------------------------------------------------------------------------------
Private Function BuildRept()
varFiltr = Null
For Each ctrl In Me.SearchSubForm.Controls
If ctrl.ControlType = acTextBox Then
If ctrl.ColumnHidden = False Then
varFiltr = varFiltr & "AllQuery." & ctrl.Name & ", "
End If
End If
Next
varFiltr = "SELECT " & varFiltr
If Right(varFiltr, 2) = ", " Then
varFiltr = Left(varFiltr, Len(varFiltr) - 2)
End If
'End If
BuildRept = varFiltr
End Function
'-------------------------------------------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------------------------------------------
 
'-------------------------------------------------------------------------------------------------------------------------------------
'This will build the WHERE section of the SQL Filter
'-------------------------------------------------------------------------------------------------------------------------------------
Private Function BuildFilter() As Variant
'Determines which form this is using
Set RptFrm = Forms!ReportsForm
'If there is no criteria return ""
If IsNull(varWhere) Then
varWhere = ""
Else
End If
'adds the where
varWhere = " WHERE (" & varWhere
'Lists
For Each ctrl In RptFrm.Controls
If ctrl.ControlType = acListBox Then
For Each varItem In ctrl.ItemsSelected
varWhere = varWhere & ctrl.Name & "='" & ctrl.ItemData(varItem) & "' OR "
Next
End If
'Takes off the last OR and puts the AND between the strings
If Right(varWhere, 4) = " OR " Then
varWhere = Left(varWhere, Len(varWhere) - 4)
varWhere = varWhere & ") AND ("
End If
Next
'Dates
If Me.AddedToListFrom > "" Then varWhere = varWhere & "[AddedToList]>=" & Format(Me.AddedToListFrom + 1, conJetDate) & " AND "
End If
If Me.AddedToListTo > "" Then varWhere = varWhere & "[AddedToList]<" & Format(Me.AddedToListTo + 1, conJetDate) & " AND "
End If
If Me.LastModifiedFrom > "" Then varWhere = varWhere & "[LastModified]>=" & Format(Me.LastModifiedFrom + 1, conJetDate) & " AND "
End If
If Me.LastModifiedTo > "" Then varWhere = varWhere & "[LastModified]<" & Format(Me.LastModifiedTo + 1, conJetDate) & ") AND "
End If
If Me.DateInactiveFrom > "" Then varWhere = varWhere & "[DateInactive]>=" & Format(Me.DateInactiveFrom + 1, conJetDate) & " AND "
End If
If Me.DateInactiveTo > "" Then varWhere = varWhere & "[DateInactive]<" & Format(Me.DateInactiveTo + 1, conJetDate) & " AND "
End If
'takes off the last AND
If Right(varWhere, 6) = " AND (" Then varWhere = Left(varWhere, Len(varWhere) - 6)
End If
BuildFilter = varWhere & ";"
End Function
'-------------------------------------------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------------------------------------------
 
'-------------------------------------------------------------------------------------------------------------------------------------
'This will export the information to Excel
'-------------------------------------------------------------------------------------------------------------------------------------
Private Sub ExportBtn_Click()
On Error GoTo errHandler
'Takes the information to build the recordsource from the previous functions
rept = BuildRept & " FROM " & "AllQuery" & BuildFilter
'Creates the query
DoCmd.DeleteObject acQuery, "qryTemp"
Set qdf = CurrentDb.CreateQueryDef("qryTemp", rept)
'Exports the query
DoCmd.OutputTo acOutputQuery, "qryTemp", acFormatXLS, , True
exitHandler:
Exit Sub
errHandler:
If Err.Number = 7874 Then
Resume Next
Else
MsgBox Err.Number & " - " & Err.Description
Resume exitHandler
End If
End Sub
'-------------------------------------------------------------------------------------------------------------------------------------
'-------------------------------------------------------------------------------------------------------------------------------------

 

[alsoascientist]

I missed this one in the declarations! (changes the dates for the Jet engine)
Const conJetDate = "\#mm\/dd\/yyyy\#"

 

[smig]

Glad we could help