Creating a Complex filter

[njitter]

Hello,

i'm creating a front-end for a report. This involves a complex filter.

The user wants to be able to select one or many from the departments, along with some date and type filters.

The filter is built with a simple function:

Function addcriteria(ByVal strExistingCriteria As String, ByVal strAdditionalCriteria As String) As String
    If Len(strExistingCriteria & "") = 0 Then
        addcriteria = strAdditionalCriteria
    Else
        addcriteria = "(" & strExistingCriteria & ")" & " and " & strAdditionalCriteria
    End If
End Function

If (Forms!frmreportfilter.chkBA_1 = True) Then
  Afdelings_Filter = addcriteria(Afdelings_Filter, "[Afdeling] Like " + Chr(34) + "*" + "BA-1" + "*" + Chr(34))
End If

<-- the other departments are added in the same way -->

I get a 'Query to complex' when i run the report-filter. I've read there is a 64K limit. I suppose the filter exceeds this limit.

Is there a way to built the filter in a way that it does not exceed the limit?

Njit

---
It's never too late to do the Right thing

 

[dhookom]

Maybe you should give us an example of what the value of your filter is when you get the message.

Duane MS Access MVP
[green]Ask a great question, get a great answer.[/green] [red]Ask a vague question, get a vague answer.[/red]
[green]Find out how to get great answers faq219-2884.[/green]

 

[njitter]

The Watch Function only shows a portion of the string but this is how it looks like

"(((((((((((((((((((((((((((((((((((((([Afdeling] Like "*BA-1*") and [Afdeling] Like "*BA-2*") and [Afdeling] Like "*BA-Alg*") and [Afdeling] Like "*CA-1*") and [Afdeling] Like "*CA-2*") and [Afdeling] Like "*CA-4*") and [Afdeling] Like "*CA-5*") and A"

---
It's never too late to do the Right thing

 

[dhookom]

Add a line of code like

Debug.Print strYourStringVariableName

This should put your full SQL statement or where clause in the debug window where you can copy and paste it into a reply.

Your sql is not correct. Do you realize that

[Afdeling] Like "*BA-1*") and [Afdeling] Like "*BA-2*")

shouldn't return any records unless you are possibly storing multiple values in the Afdeling field? I realize we are not seeing the full where clause but this could be an issue.

Duane MS Access MVP
[green]Ask a great question, get a great answer.[/green] [red]Ask a vague question, get a vague answer.[/red]
[green]Find out how to get great answers faq219-2884.[/green]

 

[FancyPrairie]

Check out this FAQ faq181-5497 it will build the Where clause for you. It works for single and multi-select listboxes, comboboxes, text boxes, ranges, option groups, and checkboxes. You only have to do 3 things to make it work.

1. Create a new module and copy and paste the functions found in the FAQ.
2. Define your tag properties as specified in the FAQ
3. Open your report as specified in the FAQ

Most people that use the BuildWhere function intially make the mistake of not defining their tag property correctly. So, if I were you, I would just attempt a couple to see how they work.

For example, the tag property for the check box labeled BA-1 would look like this:

Where=[YourTableName].[Afdeling],String,Like,BA-1*;

Now, instead of opeing the report, issue this command (to see the results of BuildWhere).

Msgbox BuildWhere (Me)

or, using debug

Debug.Print BuildWhere (Me)

 

[njitter]

FancyPrairie,

i tried to run the module but it gave an error.

The Replace function on this line is unknown

'****************
'*  Initialize  *
'****************
   
    On Error GoTo ErrHandler
    
    BuildWhere_ControlType = vbNullString       'Assume invalid
    strTemp = Replace(ctl.Tag, " ", vbNullString)   'Strip out all spaces
    
    If (InStr(strTemp, mstrcTagID) > 0) Then        'If true, Tag Property contains "Where="

I'm using Access 97..

---
It's never too late to do the Right thing

 

[FancyPrairie]

You're right. The Replace function is new to Access 2000. This Replace function should duplicate the results of the one for Access 2000. (I wrote it real quick, but it seems to work.) Just copy and paste the following function into the same module that BuildWhere is in.

Function Replace(ByVal strExpression As String, strFind As String, strReplace As String) As String

    Dim k As Integer

    k = 1
    
    While k <> 0
        k = InStr(1, strExpression, strFind)
        If (k = 1) Then
            strExpression = strReplace & Mid(strExpression, Len(strFind) + 1)
        ElseIf (k > 0) Then
            strExpression = Mid(strExpression, 1, k - 1) & strReplace & Mid(strExpression, k + Len(strFind))
        End If
    Wend
    
    Replace = strExpression

End Function

 

[njitter]

Split function also not available in Access 97..

'**************************************************************
'*  Loop to find "Where=" Tag within Controls Tag Property    *
'*  When the "Where=" is found, then parse out the item       *
'*  the caller requested (i.e. FieldName,FieldType,Operator)  *
'**************************************************************

    var = Split(strTag, mstrcTagSeparator)

    BuildWhere_GetTag = vbNullString

---
It's never too late to do the Right thing

 

[njitter]

Added the Split and Join functions myself (found with some Googling)

The module works now.. Will play with it for a while and ask questions later...

Public Function Split(ByVal strSource As String, _
   ByVal strSplitter As String) As Variant
On Error GoTo splitError

Dim varArray() As String
Dim lngPosStart As Long, lngPosStop As Long, lngSourceLength As Long

  lngSourceLength = Len(strSource)
  If (lngSourceLength > 0) Then
    If (Len(strSplitter) > 0) Then
      If (InStr(1, strSource, strSplitter) > 0) Then
        ReDim varArray(0)
        lngPosStart = 1
        'all elements in front of the splitter
        lngPosStop = InStr(lngPosStart, strSource, strSplitter)
        Do While ((lngPosStop > 0) And (lngPosStart <= lngSourceLength))
          varArray(UBound(varArray)) = Mid(strSource, lngPosStart, _
                                       (lngPosStop - lngPosStart))
          ReDim Preserve varArray(UBound(varArray) + 1)
          lngPosStart = (lngPosStop + Len(strSplitter)) 'recent change
          lngPosStop = InStr(lngPosStart, strSource, strSplitter)
        Loop
        'the element after the last splitter
        If (lngSourceLength >= lngPosStart) Then
          varArray(UBound(varArray)) = Mid(strSource, lngPosStart, _
                                       ((lngSourceLength - lngPosStart) + 1))
        Else 'remove empty element at the end
          ReDim Preserve varArray(UBound(varArray) - 1)
        End If
        Split = varArray
      Else
        Split = strSource
      End If
    Else
      Split = strSource
    End If
  Else
    Split = ""
  End If

splitError:
  If (Err.Number <> 0) Then
    Split = strSource
    Err.Clear
  End If

End Function

Public Function Join(ByVal varArray As Variant, _
  ByVal strJoiner As String) As String
  
On Error GoTo joinError

Dim lngMin As Long, lngMax As Long, lngCounter As Long, strBuffer As String
Dim strElement As String, lngElementLength As Long, lngStart As Long

  Join = ""
  strBuffer = String(1000, Chr(0))
  If (IsArray(varArray)) Then
    lngMin = LBound(varArray)
    lngMax = UBound(varArray)
    lngStart = 1
    For lngCounter = lngMin To lngMax
      If (Len(strBuffer) < lngStart) Then 'adjust bufferlength if necessary
        strBuffer = strBuffer & String(1000, Chr(0))
      End If
      strElement = varArray(lngCounter) & strJoiner
      lngElementLength = Len(strElement)
      Mid(strBuffer, lngStart, lngElementLength) = strElement
      lngStart = lngStart + lngElementLength
    Next
    'cut buffer to size: ((lngStart - 1) - strJoiner)
    Join = Left(strBuffer, ((lngStart - 1) - Len(strJoiner)))
  End If

joinError:
  If (Err.Number <> 0) Then
    Join = ""
    Err.Clear
  End If

End Function

---
It's never too late to do the Right thing

 

[njitter]

FancyPrairie,

how do i use OR's and AND's together?

The following string is created with this command:

Private Sub Command318_Click()
   MsgBox BuildWhere(Me, " OR ")
End Sub

---
It's never too late to do the Right thing

 

[FancyPrairie]

The function was designed to do ORs within a group and ANDs between groups. For example, all items selected in a multi-select listbox would be separated by ORs. The AND would separate that listbox with, say, a combobox. At some point, someone wanted to use ORs between groups so I built in that functionality. However, in your case, you have several checkboxes (each representing a group) where you want ORs rather than ANDs, but ANDs between the other controls (groups). There are 2 ways you could do it. One would be to add the word OR or AND in your Tag property and then modify the BuildWhere to accomodate it. Or put you checkboxes within a container of somekind, then they would be treated as a group (this idea has been in the back of my mind, but haven't had time to investigate it).

 

[njitter]

FancyPrairie,

the checkboxes are all on a tab-control but i do not think this counts as a group.
How would i group the checkbox controls?


---
It's never too late to do the Right thing

 

[FancyPrairie]

I don't know. As I said in the previous post, I've been contemplating it, but no solution.

They have to have a parent, like a frame or something. An Option Group is kind of what you need. Where each item is a member of the Option group. However, an Option group wouldn't work because you can only select one value.

I don't have time to explore it right now. Maybe somebody else has an idea.

 

[njitter]

The function should be able to read a list of controls that have been defined by the user.

Something like this:

Group1 = (chkBA_1, chkBA_2, chkBA_3.....)
Group2 = (....)






---
It's never too late to do the Right thing

 

[njitter]

FancyPrairie,

one thing i noticed is that the function does not take the value of the checkbox (true of false) when it builds the string..

The output is the same wether i select all checkboxes or none..



---
It's never too late to do the Right thing

 

[FancyPrairie]

Right. That's because I don't know whether you're looking for True or False or something else (Could represent, say, a department name). That's why you need to indicate it in the tag property. For example, when the checkbox is checked and you want to then check for a True value, the tag property should look like this:

Where=tablename.fieldname,Checkbox,=,True

Note that the word CheckBox can be anything. The code is really looking for Date, String, Or number to know how to format it. For example, Date needs to be surrounded by #, strings need to be surrounded by ' For every other type is doesn't matter.

 

[njitter]

I'm a bit confused

Where=[tblAfdeling].[Afdeling],Checkbox,Like,True,*BA-1*;

does not work.. I want the function to only evaluate the checked items.. It should say 'Like *BA-1*



---
It's never too late to do the Right thing

 

[FancyPrairie]

Note that the last argument in BuildWhere is a ParamArray. Therefore, you can pass it the controls you want the function to process. You would have to call BuildWhere twice. And the following code is not pretty. However, you could build the array on the fly like the second example (but I couldn't get it to work right. I'm doing something wrong...don't have time to delve into it further. Maybe you or some else can make it work...Or I'll try at lunch)

Example 1:

    Dim strWhere1 as String
    Dim strWhere2 as String

    strWhere1 = BuildWhere(Me, " OR ", chkBA_1, chkBA_2, chkBA_3,...)
    strWhere2 = BuildWhere(Me, Control1, Control2, Control3...)
    msgbox strWhere1
    msgbox strWhere2

Example 2 (concept is right, code is not quite right)

    Dim ctrl As Control
    
    Dim strWhere1 As String
    Dim strWhere2 As String
    Dim varCtrl(3) As Variant

'***************************************
'*  Build array with just check boxes  *
'***************************************
    
    ReDim varCtrl(0)
    i = 0
    varCtrl(0) = " OR "
    For Each ctrl In Me.Controls
        If (ctrl.ControlType = acCheckBox) Then
            i = i + 1
            ReDim Preserve varCtrl(i)
            varCtrl(i) = ctrl
        End If
    Next
    
    strWhere1 = BuildWhere(Me, varCtrl)

'*************************************************
'*  Build array with everything but check boxes  *
'*************************************************
    
    ReDim varCtrl(0)
    i = 0
    For Each ctrl In Me.Controls
        If (ctrl.ControlType <> acCheckBox) And (InStr(ctrl.Tag, "Where=") > 0) Then
            i = i + 1
            ReDim Preserve varCtrl(i)
            varCtrl(i) = ctrl
        End If
    Next
    
    strWhere2 = BuildWhere(Me, varCtrl)
    
    MsgBox strWhere1
    MsgBox strWhere2

 

[FancyPrairie]

You're right. This Where=[tblAfdeling].[Afdeling],Checkbox,Like,True,*BA-1*; is not correct. I had forgotten you original intent. But it appears that you are wanting to do 2 things with the check box. See if it's true and like *BA-1*. Basically, if the user checks the box, then the where clause would be "Like *BA-1*" If the user does not check the box, then no where clause is generated.

 

[FancyPrairie]

Haven't had a chance to look at this further. But you could do it this way. It calls BuildWhere for each control, rather than passing all of the controls to BuildWhere (really not much difference)

    Dim ctrl As Control
    
    Dim strWhere As String
    Dim strWhere1 As String
    Dim strWhere2 As String
    
'****************************************
'*  Build Where clause for Check Boxes  *
'****************************************

    strWhere = vbNullString
    strWhere1 = vbNullString
    strWhere2 = vbNullString
    
    For Each ctrl In Me.Controls
        If (ctrl.ControlType = acCheckBox) And (InStr(ctrl.Tag, "Where=") > 0) Then
            strWhere = BuildWhere(Me, " OR ", ctrl)
            If (Len(strWhere) > 0) Then strWhere1 = strWhere1 & " OR " & strWhere
        End If
    Next
    
    strWhere1 = " (" & Mid(strWhere1, 5) & ") "
    
'************************************************************
'*  Build Where clause for controls other than check boxes  *
'************************************************************

    For Each ctrl In Me.Controls
        If (ctrl.ControlType <> acCheckBox) And (InStr(ctrl.Tag, "Where=") > 0) Then
            strWhere = BuildWhere(Me, " AND ", ctrl)
            If (Len(strWhere) > 0) Then strWhere2 = strWhere2 & " AND " & strWhere
        End If
    Next
    
    strWhere2 = " (" & Mid(strWhere2, 6) & ") "
    
    MsgBox strWhere1 & " and " & strWhere2