Selecting Multiple criterea from a form using faq181-5497

[Delindan]

I am trying to use the buildwhere code supplied in faq181-5497
and am having trouble. I have 3 multi select list boxes which are all enabled and visible. Each has a Where= statement in the tag property. I cut and pasted the code at the bottom of my vb page and am referencing the code as follows:

Dim strWhere As String

Set DB = CurrentDb
strWhere = BuildWhere(Me)
Set qdf = DB.CreateQueryDef("", strWhere)
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSBudget = qdf.OpenRecordset

It keeps bombing on the Set qdf line with a 3316 error invalid sql statement. Any ideas?

 

[dhookom]

Delindan,
Please don't post the same question in more than one forum. Be patient and wait for an answer or direction on reposting or need for clarification.


Duane
Hook'D on Access
MS Access MVP

 

[MajP]

Set DB = CurrentDb
strWhere = BuildWhere(Me)
debug.print strWhere
'post back to tek tips

 

[Delindan]

Sorry about the duplicate posting...couldn't find the original so reposted. :-(

 

[Delindan]

This is what it came back with: ([Summary of fx and oh].[Staffing Status],String;
In (Hold))

 

[dhookom]

Clearly the expression is just a poorly constructed where clause and not a full SQL Statement as your code expects.

We can't see what any of your properties are but you should review them and possibly post them back.

Duane
Hook'D on Access
MS Access MVP

 

[MajP]

Yeah, that looks pretty bad. Obviously not returning what you want.


That original code looks very robust, but using parmateters is just something I do not do. I do this by building a where statement. Once I build a where statement I can use in in a sql statement or as a filter.

The following code is three multiselects. Once you get the first multiselect everything is just cut and paste.
Basically you build a string for each multiselect and then bring them all together in the end.
To modify this basically I just modify the control and field names.

Public Sub createFilter()
  'Need one for each multiselect
  Dim strType As String
  Dim strArea As String
  Dim strSR As String
  'Need this to bring it all together
  Dim strFilter As String
  'Need this for the looping
  Dim itm As Variant
 
  'Filter by Type
  For Each itm In Me.lstFilterByType.ItemsSelected
     If strType = "" Then
        strType = "strRequirementType = '" & Me.lstFilterByType.ItemData(itm) & "'"
     Else
       strType = strType & " OR strRequirementType = '" & Me.lstFilterByType.ItemData(itm) & "'"
     End If
  Next itm
  If Not strType = "" Then
    strType = " (" & strType & ") AND "
  End If
 
'******************************************************
 'This is a cut and paste from above 
 'Filter by Area
 For Each itm In Me.lstFilterByArea.ItemsSelected
   If strArea = "" Then
      strArea = "autoAreaID = " & Me.lstFilterByArea.ItemData(itm)
   Else
     strArea = strArea & " OR autoAreaID = " & Me.lstFilterByArea.ItemData(itm)
   End If
 Next itm
  If Not strArea = "" Then
    strArea = " (" & strArea & ") AND "
  End If
 
 'Filter by parent SR
 For Each itm In Me.lstSR.ItemsSelected
   If strSR = "" Then
      strSR = "strParentSRnumber = '" & Me.lstSR.ItemData(itm) & "'"
   Else
     strSR = strSR & " OR strParentSRnumber = '" & Me.lstFilterByArea.ItemData(itm) & "'"
   End If
 Next itm
 If Not strSR = "" Then
    strSR = " (" & strSR & ") AND "
 End If
 '*****************************************************

 'Put it all together 
 strFilter = strType & strArea & strSR
 If Not strFilter = "" Then
    strFilter = Left(strFilter, Len(strFilter) - 5)
 End If


End Sub

 

[dhookom]

I try not to hard-code this type of code. This is a generic function that I use for all multi-select list boxes:

Function BuildIn(lboListBox As ListBox, _
        strFieldName As String, strDelim As String) As String
[green]    'send in a list box control object
    'strFieldName is the name of the field to use in the WHERE clause
    'strDelim should be "" for numbers, "'" for text, and "#" for dates
    'BuildIn(Me.lboColors,"[ColorField]", "'") might return something like:
    ' AND [ColorField] IN ('Red','White','Yellow','Green')[/green]
    Dim strIn As String
    Dim varItem As Variant
        
    If lboListBox.ItemsSelected.Count > 0 Then
        strIn = " AND " & strFieldName & " In ("
        For Each varItem In lboListBox.ItemsSelected
            strIn = strIn & strDelim & lboListBox.ItemData(varItem) & strDelim & ", "
        Next
        'remove the last ", " and add the ")"
        strIn = Left(strIn, Len(strIn) - 2) & ") "
    End If
    BuildIn = strIn

End Function

Duane
Hook'D on Access
MS Access MVP

 

[Delindan]

I'll give this a try and let you know. Thanks!

 

[Delindan]

Ok...I cut and paste the buildin function to the bottom of my code and used it in the following way:

Dim strsql As String


strsql = "SELECT * FROM [Summary of fx and oh] WHERE 1=1 "
strsql = strsql & BuildIn(Me.Lstss, "[Staffing Status]", "'")
strsql = strsql & BuildIn(Me.Lstacc, "[Act Cost Center]", "'")
strsql = strsql & BuildIn(Me.Lstcountry, "[Country]", "'")
Debug.Print strsql

Set DB = CurrentDb
Set qdf = DB.CreateQueryDef("", strsql)
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSBudget = qdf.OpenRecordset

and it is erring on the first use of buildin() saying expected array??

 

[dhookom]

I haven't ever had an error using this function. Do you have another function with the same name?

I typically save the code in a general module with a name like "modControlCode".

I don't think you need any of the "For Each prm" code uncless there is something in [Summary of fx and oh].

Duane
Hook'D on Access
MS Access MVP

 

[Delindan]

I built this report before they wanted to filter it so there are parameters in the summary of fx and oh sub queries. I will try saving seperately and see what happens.

 

[Delindan]

still getting the error. I'm obviously doing something wrong. When I press help on the error message it comes up with the following:

Expected array

A variable name with a subscript indicates the variable is an array. This error has the following cause and solution:


The syntax you specified is appropriate for an array, but no array with this name is in scope.
Check to make sure the name of the variable is spelled correctly. Unless the module contains Option Explicit, a variable is created on first use. If you misspell the name of an array variable, the variable may be created, but not as an array.


Any ideas?

 

[dhookom]

Can you provide the exact code you used?
Does your code compile?
It sounds like you might have a line like:

Dim BuidIn()

someplace in your code

Duane
Hook'D on Access
MS Access MVP

 

[Delindan]

Here's all the references:

Private Sub cmdStartExport___Click()

Dim DB As DAO.Database
Dim xlApp As New Excel.Application
Dim RSBudget As DAO.Recordset
Dim WB As Workbook
Dim strFolder As String
Dim strFilename As String
Dim introw As Long
Dim strCC As String
Dim strPosition As String
Dim strExportTemplate As String
Dim strStart As String
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim BuildIn As String
Dim strsql As String


strsql = "SELECT * FROM [Summary of fx and oh] WHERE 1=1 "
strsql = strsql & "'" & BuildIn(Me.Lstss, "[Staffing Status]", "'")
strsql = strsql & "'" & BuildIn(Me.Lstacc, "[Act Cost Center]", "'")
strsql = strsql & "'" & BuildIn(Me.Lstcountry, "[Country]", "'") & ";'"
Debug.Print strsql

Set DB = CurrentDb
Set qdf = DB.CreateQueryDef("", strsql)
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSBudget = qdf.OpenRecordset

and here is the code I pasted down at the bottom:

Private Function BuildIn(lboListBox As ListBox, strFieldName As String, strDelim As String) As String
'send in a list box control object
'strFieldName is the name of the field to use in the WHERE clause
'strDelim should be "" for numbers, "'" for text, and "#" for dates
'BuildIn(Me.lboColors,"[ColorField]", "'") might return something like:
' AND [ColorField] IN ('Red','White','Yellow','Green')
Dim strIn As String
Dim varItem As Variant

If lboListBox.ItemsSelected.Count > 0 Then
strIn = " AND " & strFieldName & " In ("
For Each varItem In lboListBox.ItemsSelected
strIn = strIn & strDelim & lboListBox.ItemData(varItem) & strDelim & ", "
Next
'remove the last ", " and add the ")"
strIn = Left(strIn, Len(strIn) - 2) & ") "
End If
BuildIn = strIn

End Function

 

[dhookom]

That's what I thought. Get rid of the red code:

    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    [red]'Dim BuildIn As String[/red]
    Dim strsql As String

Duane
Hook'D on Access
MS Access MVP

 

[Delindan]

Excitement!! After much fiddling I got this to work. I took out the dim buildin as string from the main routine althought I'm not sure why I didn't need it in there. This is what I got to work

strsql = "SELECT * FROM [Summary of fx and oh] WHERE "
strsql = strsql & BuildIn(Me.Lstss, "[Staffing Status]", "'", strsql)
strsql = strsql & BuildIn(Me.Lstacc, "[Act Cost Center]", "'", strsql)
strsql = strsql & BuildIn(Me.Lstcountry, "[Country]", "'", strsql)
strsql = strsql & ";"
Debug.Print strsql

If Right(strsql, 6) = "WHERE;" Then
Set DB = CurrentDb
Set qdf = DB.QueryDefs("Summary of fx and oh")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSBudget = qdf.OpenRecordset
Else
Set DB = CurrentDb
Set qdf = DB.CreateQueryDef("", strsql)
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set RSBudget = qdf.OpenRecordset
End If

Private Function BuildIn(lboListBox As ListBox, strFieldName As String, strDelim As String, strsql As String) As String

Dim strIn As String
Dim varItem As Variant

If lboListBox.ItemsSelected.Count > 0 Then
If Right(strsql, 6) <> "WHERE " Then
strIn = "AND ("
Else
strIn = "("
End If

For Each varItem In lboListBox.ItemsSelected
strIn = strIn & strFieldName & " = " & strDelim & lboListBox.ItemData(varItem) & strDelim & " OR "
Next
strIn = Left(strIn, Len(strIn) - 4) & ") "
End If
BuildIn = strIn

End Function

One last question. How do I get my list boxes to reset after the procedure is run and how does a user unselect something if they accidently click something in the list box?

Thanks!!

 

[dhookom]

I'm not sure why you messed with the BuildIn() function. I would change it back.

I typically use code like:

    strsql = "SELECT * FROM [Summary of fx and oh] WHERE 1=1 "
    strsql = strsql & BuildIn(Me.Lstss, "[Staffing Status]", "'")

I then don't have to check for the last characters being "WHERE" which removes the need for the If...Then code.

Code to clear a listbox from Allen Browne's excellent web site:

Function ClearList(lst As ListBox) As Boolean
On Error GoTo Err_ClearList
    'Purpose:   Unselect all items in the listbox.
    'Return:    True if successful
    'Author:    Allen Browne. [URL unfurl="true"]http://allenbrowne.com[/URL]  June, 2006.
    Dim varItem As Variant

    If lst.MultiSelect = 0 Then
        lst = Null
    Else
        For Each varItem In lst.ItemsSelected
            lst.Selected(varItem) = False
        Next
    End If

    ClearList = True

Exit_ClearList:
    Exit Function

Err_ClearList:
    'Call LogError(Err.Number, Err.Description, "ClearList()")
    Resume Exit_ClearList
End Function

Duane
Hook'D on Access
MS Access MVP

 

[Delindan]

I couldn't get it to work until I started messing with it...probably because of something else I was doing. Because I'm fairly new to sql I created the query I wanted through query design and snagged the syntax and then worked with it from there. I will try it your way again. Thanks for the clear code and all the other help!

 

[Delindan]

Got it to work as origionally given without problems this time. As usual...self created issue. I always learn a lot from these efforts though. So what if the user decides they don't want what they selected before they hit the start button...is there any way to back out before the routine is started from the button on the form?