Using form to enter criteria for a query 3

[shart00]

The query "qrySummary" has the field [CC] that is currently being updated by each user by criteria that always start with:
Between xxxx and xxxxx
what I need to do is allow the user to enter data on the form "frmEntry" that fills xxxx xxxx
the only thing is that it would be helpful to have a few extra places where they could enter a few or's.
I.E. if they ultimately need
Between 50 and 55 or 65 or 75 or 103 or 115
the could use the form that would resemble:
Between [a control to allow them to enter] and [a control] or
[ control]
or
[ control]
etc....

Any suggestions?

 

[FancyPrairie]

Check out this FAQ faq181-5497 It will do what you want. It handles 0 to many listboxes, comboboxes, textboxes, ranges, option groups, and checkboxes. The key is setting up the tag property. You only have to do 3 things to make it work:

1. Create a new module and copy the function from the FAQ and paste it into your new module
2. Define the tag property of your contols as described in the FAQ.
3. Call the function. It will return the Where clause without the word where

 

[shart00]

That seems great, but a tad "Greek" to me. I have not been too great at using modules. Would you happen to know a "Dummy" vesion? As I am reading through it, the code is refrenceing check boxes, list boxes, etc and all I am using are text boxes and I am not sure of what I need to cut (if anything).

 

[FancyPrairie]

First, you kind of through a kink in things, because you are using OR between ranges rather than AND as would normally be the case. So I've modified the code and it is listed below. You don't have to worry about the code or how it works (you can figure that out as you become more experienced). Just create a new module and then highlight and copy the code below and paste it into your new module.

You said your field name was CC but you did not specify your table name. Therefore, assuming your table name is tblCC, set your tag property and name for the first field (that represents the begin range) to:

Name: txtCC1_BeginR
Tag: Where=tblCC.CC,Long;

Set the name of the 2nd field (that represents the end range) to (don't need to mess with the tag property):

Name: txtCC1_EndR

For your second set of ranges, define them like this:

Name: txtCC2_BeginR
Tag: Where=tblCC.CC,Long;

Name: txtCC2_EndR

Note that the names of the pairs have the same prefix (i.e. txtCC1). Also note that the 1st field in the range ends with "_BeginR" and the 2nd field in the range ends with "_EndR"

After you have copied and pasted the code below and named your controls as above and set your tag properties as above, in the OnClick event of a command button, enter this:

MsgBox BuildWhere(Me," OR ")

Option Compare Database
Option Explicit

'*******************************************
'*  Constant Declarations for this module  *
'*******************************************

    Const mstrcTagID As String = "Where="               'Tag Property identifier to build Where Clause
    Const mstrcRange_Begin As String = "_BeginR"        'String to be appended to the base name of a control that represents the Begin part of a range
    Const mstrcRange_End As String = "_EndR"            'String to be appended to the base name of a control that represents the End part of a range
    Const mstrcDateSymbol = "#"                         'Symbol for dates (i.e. Date = #10/24/2004#)
    Const mstrcFldSeparator = ","                       'Separates items with Where= Tag
    Const mstrcStringSymbol = "'"                       'Symbol for strings (i.e. where name = 'dog')
    Const mstrcTagSeparator = ";"                       'Separates Tag items in controls Tag Property
    
'+********************************************************************************************
'*
'$  Function:   BuildWhere
'*
'*  Author:     FancyPrairie
'*
'*  Date:       October, 1998
'*
'*  Purpose:    This routine will build a Where clause based on the items the user selected/entered on a
'*              Report Criteria form (or any type of form that the caller may use to build a Where clause
'*              based on the items selected).
'*
'*              This routine assumes that, in order for the control to be included in the criteria,
'*              it must satisfy the following conditions:
'*
'*                  1. Tag Property must contain:  Where=TableName.FieldName,FieldType[,Operator,Value]
'*                         a. TableName.FieldName is the name of the Table and field to filter on
'*                            (example: tblEmployee.lngEmpID)
'*                         b. FieldType must be one of the following words: String, Date
'*                            (Note: String and Date are the only ones that have special meaning at this time
'*                                   (' or #).  However, if the FieldType is not String or Date then set
'*                                   you can leave the FieldType empty or (anticipating future uses) set the FieldType
'*                                   to Long, Integer, Byte, Single, Double, Boolean.)
'*                         c. Operator (optional) can be one of the following: = <> < > <= >= Like IsNull
'*                            (Default is =)
'*                         d. Value (optional) to be filtered on (more for option groups and check boxes)
'*                            (Note: This is primarily intended to be used by Option groups and check boxes.
'*                                   For example, suppose you have a check box.  If the box is checked, then
'*                                   the you need to set the Value argument equal to True and the FieldType
'*                                   should be set to Boolean.  Else Value should be set to False.)
'*                  2. Control must be Enabled
'*                  3. Control must be visible
'*                  4. If the control is part of a range, then the name of the control must end with
'*                     either _BeginR (begin range control) or _EndR (end range control)
'*
'*              As of this writing, the following controls are checked:
'*                  1. List Boxes (multiselect and single select)
'*                  2. Ranges (2 controls that are grouped together (i.e. Begin and End Dates)
'*                  3. Text Boxes
'*                  4. Combo Boxes
'*                  5. Option Groups
'*                  6. Check Boxes
'*
'*  Arguments:  frm (form)
'*              ----------
'*              Represents the form (Report Criteria form) that contains the controls
'*              from which the Where clause is to be created.
'*
'*              varCtl (ParamArray)
'*              -------------------
'*              Indicates which controls you want checked.  If this argument is missing then
'*              this routine loops thru all of the controls on the form searching for the ones
'*              whose tag property is set accordingly.  Else it only checks the ones passed by the caller.
'*
'*  Control Examples:
'*
'*              ListBox
'*              -------
'*                Visible ........ Yes
'*                Enabled ........ Yes
'*                Multi Select ... None, Simple, or Extended
'*                Tag ............ Where=tblEmployee.lngDepartmentID,Number;
'*
'*              TextBox
'*              -------
'*                Visible ........ Yes
'*                Enabled ........ Yes
'*                Tag ............ Where=tblEmployee.dteBirth,Date,>;
'*
'*              Range
'*              -----
'*                Text Box (Begin Date Range: Name must end with _BeginR)
'*                  Name ...... txtHireDate_BeginR
'*                  Visible ... Yes
'*                  Enabled ... Yes
'*                  Tag ....... Where=tblEmployee.dteHire,Date;
'*
'*                Text Box (End Date Range: Name must end with _EndR)
'*                  Name ...... txtHireDate_BeginR
'*                  Visible ... Yes
'*                  Enabled ... Yes
'*                  Tag ....... (not used...function relies on tag property of BeginDateRange text box)
'*
'*              Option Group
'*              ------------
'*                  Visible ... Yes
'*                  Enabled ... Yes
'*                  Tag ....... Where=tblEmployee.lngID,Long,=,3;
'*
'*              Check Boxes
'*              -----------
'*                  Visible ... Yes
'*                  Enabled ... Yes
'*                  Tag ....... Where=tblEmployee.ysnActive,Boolean,=,True;
'*
'*  Calling Example:
'*              Docmd.OpenReport "rptYourReport",acViewPreview,,BuildWhere(Me, " OR ")
'*
'*        or    strWhere = BuildWhere(Me, " OR ")
'*
'-*********************************************************************************************************'
'
Function BuildWhere(frm As Form, 
                    strOp as String, _
         ParamArray varCtl() As Variant)
             
'********************************
'*  Declaration Specifications  *
'********************************

    Dim ctl As Control                  'Control currently being processed
    Dim ctlEndR As Control              '2nd control of Range pair
    
    Dim varItem As Variant              'Items within multiselect list box
    
    Dim strAnd As String                'And or ""
    Dim strAndOr As String              'Either "And" or "Or"
    Dim strCtlType As String            'Control Type of control being processed (also see error handler)
    Dim strFieldName As String          'Table.FieldName value
    Dim strFieldType As String          'FieldType ' or #
    Dim strFieldValue As String         'Value
    Dim strOperator As String           'Operator (= <> > < etc)
    Dim strSuffix As String             'Suffix to be appended at end of a string
    Dim strWhere As String              'Where clause to be returned to caller
    
    Dim i As Integer                    'Working Variable
    
'****************
'*  Initialize  *
'****************

    On Error GoTo ErrHandler

    strWhere = vbNullString
    strAnd = vbNullString
    
'**************************************
'*  Begin loop thru controls on form  *
'**************************************

    If (UBound(varCtl) = -1) Then
        For Each ctl In frm.Controls
            GoSub CreateWhere
        Next
    Else
        For i = 0 To UBound(varCtl)
            Set ctl = varCtl(i)
            GoSub CreateWhere
        Next i
    End If

'***********************
'*  Save Where Clause  *
'***********************

    BuildWhere = strWhere
    
'********************
'*  Exit Procedure  *
'********************
        
ExitProcedure:

    Exit Function

'*********************************************
'*  Create Where Clause for current control  *
'*********************************************

CreateWhere:

    strCtlType = BuildWhere_ControlType(frm, ctl)
    
    Select Case strCtlType
            
        Case "Range":       GoSub GetTag: GoSub BuildRange   'strWhere = strWhere & strAnd & BuildWhere_Range(frm, ctl)
        Case "ListBox":     GoSub GetTag: GoSub BuildListBox   'strWhere = strWhere & strAnd & BuildWhere_ListBox(frm, ctl)
        Case "TextBox":     GoSub GetTag: GoSub BuildTextBox   'strWhere = strWhere & strAnd & BuildWhere_TextBox(frm, ctl)
        Case "OptionGroup": GoSub GetTag: GoSub BuildOptionGroup   'strWhere = strWhere & strAnd & BuildWhere_OptionGroup(frm, ctl)
        Case "CheckBox":    GoSub GetTag: GoSub BuildCheckBox      'strWhere = strWhere & strAnd & BuildWhere_CheckBox(frm, ctl)
        Case "ComboBox":    GoSub GetTag: GoSub BuildComboBox
        
    End Select

    If (Len(strWhere) > 0) Then strAnd = strOp
    
    Return

'##########################################################################################
'#                                    Retrieve Tag Items                                  #
'##########################################################################################

GetTag:

    strFieldName = BuildWhere_GetTag("FieldName", ctl.Tag)
    If (Len(strFieldName) = 0) Then Err.Raise vbObjectError + 2000, "BuildWhere (GetTag);" & Err.Source, "Invalid Tag Property (" & ctl.Tag & ")" & vbCrLf & vbCrLf & "The Tag Property should look like this:" & vbCrLf & mstrcTagID & "TableName.FieldName" & mstrcFldSeparator & "FieldType[" & mstrcFldSeparator & "Operator]" & vbCrLf & vbCrLf & "(where FieldType is either String, Date, or Number and Operator (optional) is either =, <>, <, >, <=, >=, Like)"
    strFieldType = BuildWhere_GetTag("FieldType", ctl.Tag)
    
    strOperator = BuildWhere_GetTag("Operator", ctl.Tag)
    strFieldValue = BuildWhere_GetTag("Value", ctl.Tag)
    
    Return
    
'##########################################################################################
'#                                         Build Range                                    #
'##########################################################################################

BuildRange:

    '**********************************************************
    '*  Determine control that represents the End date range  *
    '**********************************************************
    
    On Error Resume Next
    
    Set ctlEndR = frm(Left$(ctl.Name, Len(ctl.Name) - Len(mstrcRange_Begin)) & mstrcRange_End)
    
    If (Err.Number = 2465) Then
        On Error GoTo 0
        Err.Raise vbObjectError + 2001, "BuildWhere (" & strCtlType & ");" & Err.Source, "Invalid Range" & vbCrLf & vbCrLf & "You have declared a text box that represents the Begin Range (" & ctl.Name & ") but you did not declare a control that represents the End Range (" & Left$(ctl.Name, Len(ctl.Name) - Len(mstrcRange_Begin)) & mstrcRange_End & ")"
    End If
    
    If (IsNull(ctlEndR)) Then
        On Error GoTo 0
        Err.Raise vbObjectError + 2002, "BuildWhere (" & strCtlType & ");" & Err.Source, "Invalid Range" & vbCrLf & vbCrLf & "Your entered a value for the Begin Range but failed to enter a value for the End Range."
    End If
    
    '*****************
    '*  Build Where  *
    '*****************
    
    On Error GoTo ErrHandler
                
    If (Len(strFieldValue) = 0) Then strFieldValue = CStr(ctl.Value)
    
    If (strFieldType = "#") Then   'IFT, then Date Field
        strWhere = strWhere & strAnd & " (" & strFieldName & " Between #" & strFieldValue & "# AND #" & ctlEndR.Value & " 23:59:59#) "
    Else
        strWhere = strWhere & strAnd & " (" & strFieldName & " Between " & strFieldType & strFieldValue & strFieldType & " AND " & strFieldType & ctlEndR.Value & strFieldType & ") "
    End If
    
    strAnd = strOp
                
    Return

'##########################################################################################
'#                                         List Box                                       #
'##########################################################################################

BuildListBox:

'*******************************************
'*  Determine Operator (=, >, Like, etc.)  *
'*******************************************
    
    strAndOr = vbNullString
    If (Len(strOperator) > 0) Then
        If (strOperator = "<>") Then strAndOr = " AND " Else strAndOr = " OR "
    End If

    If (Len(strOperator) = 0) Or (strOperator = "=") Then
        strWhere = strWhere & strAnd & " (" & strFieldName & " In ("
        strSuffix = ", "
    Else
        strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " "
        strSuffix = ") " & strAndOr
    End If
                
        
    If (ctl.MultiSelect) Then
        For Each varItem In ctl.ItemsSelected
            strWhere = strWhere & strFieldType & ctl.Column(ctl.BoundColumn - 1, varItem) & strFieldType & strSuffix
        Next varItem

        strWhere = Mid(strWhere, 1, Len(strWhere) - Len(strSuffix)) & ")) "

    
    Else
        If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Column(ctl.BoundColumn - 1)
        strWhere = strWhere & strFieldType & strFieldValue & strFieldType & strSuffix
    End If
    
    strAnd = strOp
    
    Return

'##########################################################################################
'#                                         Text Box                                       #
'##########################################################################################

BuildTextBox:

    If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Value
    
    strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " " & strFieldType & strFieldValue & strFieldType & ") "
    
    strAnd = strOp
                
    Return

'##########################################################################################
'#                                       Option Group                                     #
'##########################################################################################

BuildOptionGroup:

    If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Value
    
    strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " " & strFieldType & strFieldValue & strFieldType & ") "
    strAnd = strOp
                
    Return

'##########################################################################################
'#                                         Check Box                                      #
'##########################################################################################

BuildCheckBox:

    If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Value
    
    strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " " & strFieldType & strFieldValue & strFieldType & ") "
    strAnd = strOp
                
    Return

'##########################################################################################
'#                                         Combo Box                                      #
'##########################################################################################

BuildComboBox:

'*******************************************
'*  Determine Operator (=, >, Like, etc.)  *
'*******************************************
    
    strAndOr = vbNullString
    If (Len(strOperator) > 0) Then
        If (strOperator = "<>") Then strAndOr = " AND " Else strAndOr = " OR "
    End If

    If (Len(strOperator) = 0) Or (strOperator = "=") Then
        strWhere = strWhere & strAnd & " (" & strFieldName & " In ("
        strSuffix = ", "
    Else
        strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " "
        strSuffix = ") " & strAndOr
    End If
                
    If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Column(ctl.BoundColumn - 1)
    strWhere = strWhere & strFieldType & strFieldValue & strFieldType & strSuffix

    strAnd = strOp
    
    Return

'****************************
'*  Error Recovery Section  *
'****************************
        
ErrHandler:
    
    Err.Raise Err.Number, "BuildWhere (" & strCtlType & ");" & Err.Source, Err.Description

End Function

'+********************************************************************************************
'*
'$  Function:   BuildWhere_ControlType
'*
'*  Author:     FancyPrairie
'*
'*  Date:       April, 1998
'*
'*  Purpose:    This routine determines if a control should be included (valid) if it meets the following conditions:
'*
'*              List Boxes
'*                 1. Tag Property contains: Where=
'*                 2. At least one item selected
'*                 3. List Box is enabled
'*                 4. List Box is visible
'*
'*              Range
'*                 1. Tag Property contains: Where=
'*                 2. Name of control ends with "_Begin"
'*                 3. Value of control is NOT Null
'*                 4. Control is enabled
'*                 5. Control is visible
'*
'*              Text Box
'*                 1. Tag Property contains: Where=
'*                 2. Value of control is NOT Null
'*                 3. Control is enabled
'*                 4. Control is visible
'*
'*              Combo Boxes
'*                 1. Tag Property contains: Where=
'*                 2. One item selected
'*                 3. Combo Box is enabled
'*                 4. Combo Box is visible
'*
'-********************************************************************************************
'
Function BuildWhere_ControlType(frm As Form, ctl As Control) As String

'********************************
'*  Declaration Specifications  *
'********************************

    Dim strTemp As String       'Working variable

'****************
'*  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="
    
        If (ctl.ControlType = acListBox) Then
            
            If (ctl.MultiSelect) And (ctl.ItemsSelected.Count > 0) And (ctl.Enabled) And (ctl.Visible) Then BuildWhere_ControlType = "ListBox"
            If (Not ctl.MultiSelect) And (Not IsNull(ctl.Value)) And (ctl.Enabled) And (ctl.Visible) Then BuildWhere_ControlType = "ListBox"
               
        ElseIf (((ctl.ControlType = acTextBox) And (Right$(ctl.Name, Len(mstrcRange_End)) <> mstrcRange_End)) Or (ctl.ControlType = acComboBox) Or (ctl.ControlType = acOptionGroup) Or (ctl.ControlType = acCheckBox)) And (Not IsNull(ctl.Value)) And (Len(ctl.Value) > 0) And (ctl.Enabled) And (ctl.Visible) Then
            
            If (Right$(ctl.Name, Len(mstrcRange_Begin)) = mstrcRange_Begin) Then
                On Error GoTo 0
                If (Not BuildWhere_ValidRange(frm, ctl)) Then Err.Raise vbObjectError + 2002, "BuildWhere_ControlType", "Incomplete Range Specifications." & vbCrLf & vbCrLf & "You failed to enter/select a value for " & ctl.Name
                On Error GoTo ErrHandler
                
                BuildWhere_ControlType = "Range"
            
            ElseIf (ctl.ControlType = acTextBox) Then
                BuildWhere_ControlType = "TextBox"
            ElseIf (ctl.ControlType = acComboBox) Then
                BuildWhere_ControlType = "ComboBox"
            ElseIf (ctl.ControlType = acOptionGroup) Then
                BuildWhere_ControlType = "OptionGroup"
            ElseIf (ctl.ControlType = acCheckBox) Then
                BuildWhere_ControlType = "CheckBox"
            End If
        
        End If
    
    End If
    
'********************
'*  Exit Procedure  *
'********************
        
ExitProcedure:

    Exit Function

'****************************
'*  Error Recovery Section  *
'****************************
        
ErrHandler:
    
    Err.Raise Err.Number, "BuildWhere_ControlType;" & Err.Source, Err.Description
    
End Function


'+********************************************************************************************
'*
'$  Function:   BuildWhere_ValidRange
'*
'*  Author:     FancyPrairie
'*
'*  Date:       April, 1998
'*
'*  Purpose:    Determines if the values of 2 controls, that represent ranges, are valid.  They are not valid
'*              if one or both controls do not contain a value.  For example, the user may have entered a begin
'*              date, but failed to enter an end date.
'*
'*  Arguments:  frm (form)
'*              ----------
'*              Form that contains the controls to be processed.
'*
'*              avarParControls (variant Parameter Array)
'*              -----------------------------------------
'*              List of contol(s) to be processed.  If this array is empty, then this routine will
'*              retrieve all of the "valid" controls on the form specified.
'*
'-********************************************************************************************
'
Function BuildWhere_ValidRange(frm As Form, ctl As Control) As Boolean

'********************************
'*  Declaration Specifications  *
'********************************

    Dim ctlEnd As Control
    
'******************************************************************
'*  Create array with just those text boxes that meet the specs.  *
'******************************************************************
    
    On Error GoTo ErrHandler
    
    Set ctlEnd = frm(Left(ctl.Name, Len(ctl.Name) - Len(mstrcRange_Begin)) & mstrcRange_End)
    
    If (IsNull(ctl)) Or (Len(ctl) = 0) Or (IsNull(ctlEnd)) Or (Len(ctlEnd) = 0) Then
        BuildWhere_ValidRange = False
    Else
        BuildWhere_ValidRange = True
    End If
    
'********************
'*  Exit Procedure  *
'********************
        
ExitProcedure:

    Exit Function

'****************************
'*  Error Recovery Section  *
'****************************
        
ErrHandler:
    
    Err.Raise Err.Number, "BuildWhere_ValidRange;" & Err.Source, Err.Description
    
End Function

'+********************************************************************************************
'*
'$  Function:   BuildWhere_GetTag
'*
'*  Author:     FancyPrairie
'*
'*  Date:       April, 1998
'*
'*  Purpose:    This routine will return the value for a given Tag Item.  The caller specifies
'*              which item they want returned.  Possible items are:
'*                  1. FieldName
'*                  2. FieldType
'*                  3. Operator
'*                  4. Value
'*
'*              Note that this routine assumes the Tag Property contains an item that is formatted as:
'*                  Where=TableName.TableField,FieldType[,Operator,Value].
'*
'*  Arguments:  strFunction (string)
'*              --------------------
'*              Can be one of: FieldName, FieldType, Operator, Value
'*
'*              strTag (string)
'*              ---------------
'*              String that contains an item that is formatted as:
'*                  Where=TableName.TableField,FieldType[,Operator,Value].
'*
'-********************************************************************************************
'
Function BuildWhere_GetTag(strFunction As String, strTag As String) As String

'********************************
'*  Declaration Specifications  *
'********************************

    Dim i As Integer            'Working variable
    Dim j As Integer            'Working variable
    Dim k As Integer            'Working variable
    
    Dim strTemp As String       'Working variable
    Dim var As Variant          'Working variable
        
    On Error GoTo ErrHandler
    
'**************************************************************
'*  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
    
    For i = 0 To UBound(var)
        
        strTemp = Replace(CStr(var(i)), " ", vbNullString)
        
        j = InStr(1, strTemp, mstrcTagID)   'Find "Where="
        
        If (j = 1) Then                     'If true, found "Where="
            
            strTemp = CStr(var(i))
            j = InStr(1, strTemp, "=")
            
            var = Split(Mid(strTemp, j + 1), mstrcFldSeparator)
            
            '***************
            '*  FieldName  *
            '***************
            
            If (strFunction = "FieldName") Then
                BuildWhere_GetTag = Trim(CStr(var(0)))
            
            '***************
            '*  FieldType  *
            '***************
            
            ElseIf (strFunction = "FieldType") Then
                If (UBound(var) < 1) Then
                    BuildWhere_GetTag = vbNullString
                Else
                    Select Case Trim(CStr(var(1)))
                        Case "String": BuildWhere_GetTag = mstrcStringSymbol
                        Case "Date": BuildWhere_GetTag = mstrcDateSymbol
                        Case Else: BuildWhere_GetTag = vbNullString
                    End Select
                End If

            '**************
            '*  Operator  *
            '**************

            ElseIf (strFunction = "Operator") Then
                If (UBound(var) < 2) Then BuildWhere_GetTag = "=" Else BuildWhere_GetTag = Trim(CStr(var(2)))

            '***********
            '*  Value  *
            '***********

            ElseIf (strFunction = "Value") Then
                If (UBound(var) < 3) Then
                    BuildWhere_GetTag = vbNullString
                Else
                    BuildWhere_GetTag = Trim(CStr(var(3)))
                End If
                
            End If
            
            Exit Function
            
        End If
    
    Next i

'********************
'*  Exit Procedure  *
'********************

ExitProcedure:

    Exit Function
    
'********************
'*  Error Recovery  *
'********************

ErrHandler:

    Err.Raise Err.Number, "BuildWhere_GetTag;" & Err.Source, Err.Description
    
End Function

 

[shart00]

Ok, now a message box is appearing showing Manpower.Cost Center Between 7800 and 7999 OR Manpower.Cost Center Between 9248 and 9348

The thing is that it needs to be Or 9248 Or 9348
So that it picks up the range of 7800 thru 7999 or the values of 9248 or 9348.

Therefore I changed the names of the 3rd and 4th boxes to txtCC2 and txtCC3 respectively with Where=Manpower.Cost Center,long; as the tag of each. Now the msgbox shows the criteria as it is needed. Now, just how to make that button run the report.

Also, question... What should be the control source of the form? Should it be the query that is running the report? Currently the query running the report uses 2 queries. Manpower and Overtime. The "manpower" from manpower.cost center,long; is using that query not a table. Will that cause errors?

 

[FancyPrairie]

The recordsource of the form is not in play here. Simply set the recordsource of your report to the query you want. In the OnClick event of the command button, enter something like this:

Docmd.OpenReport "rptYourReport",acViewPreview,,BuildWhere(Me, " OR ")

It doesn't matter whether you're using a query or table as long as manpower.cost center is a valid statement if you were to include it in a where clause in the SQL statement of your query. Because, that's all this function is doing, building the where clause and the tag property gives it the syntax.

 

[shart00]

Only thing I had to change was:
Where =manpower.cost center,long;
to
where=manpower.[cost center],long;

and all is working fine.

Also... when I copied the code the debugger made me change:

Function BuildWhere(frm As Form,
strOp as String, _
ParamArray varCtl() As Variant)

to:
Function BuildWhere(frm As Form, strOp as String, _
ParamArray varCtl() As Variant)

But thank you so very much! It is working and I have a feeling that this will save everyone time!

 

[shart00]

Found a slight problem...
Some people are running the report however some are simply running the query and downloading it to excel and formatting and using the data as links.
I have incorporated an option group Me.Format with 1= Access Report and 2=Excel Download.
Next in the "Run Report" command button On Click() I wrote ---

If me.format = 1 then
DoCmd.OpenReport "Summary Time and Attendance Register", acViewPreview, , BuildWhere(Me, "OR")
ElseIf Me.Format = 2 Then
DoCmd.OpenQuery "Summary Time and Attendance Register", acViewPreview, acReadOnly
End if

However, as I am sure you can see, I have not found a way to use the BuildWhere(Me, "OR") for when me.format = 2.
Suppose I should have thought of this but until now, no one has fessed up to downloading the report (or I should say Query)

 

[FancyPrairie]

I'm not clear on the problem. But if they are downloading the query, why not recreate the query prior to opening the report? Something like this (I don't have time to get into details, maybe later)

Dim qdf as QueryDef
Dim strSQL as String
Dim strWhere as String

strSQL = "Select * From YourTable "
strWhere = BuildWhere(Me," OR ")

if (len(strWhere) > 0) then strSQL = strSQL & " Where " & strWhere

Now set the querydef's sql statement to strSQL

 

[shart00]

The problem is that before using the form, everyone would open the query in design view, save their criteria, then run the report and download a snapshot. However, some are now saying that they would open the query in design view, save their criteria, and export the query into an excel file.
When using the form and the code with the BuildWhere.. there is no place to put the BuildWhere in the:'
docmd.openquery "Summary Time and Attendance Register",acviewnormal
Therefore if the view the query the criteria is not used.

Here is what I now have for the On Click of the button:

Private Sub Run_Click()
Dim qdf As QueryDef
Dim strSQL As String
Dim strWhere As String
strSQL = "Select * From Summary Time and Attendance Register"
strWhere = BuildWhere(Me, " OR ")

If (Len(strWhere) > 0) Then strSQL = strSQL & " Where " & strWhere

If Me.Format = 1 Then
DoCmd.OpenReport "Summary Time and Attendance Register", acViewPreview, , BuildWhere(Me, "OR")
Select Case MsgBox("Download Report", vbInformation + vbYesNo, "Download Snapshot")
Case vbYes
DoCmd.OutputTo acOutputReport, "Summary Time and Attendance Register", "SnapshotFormat(*.snp)"
Case vbNo

DoCmd.Close
End Select
ElseIf Me.Format = 2 Then
DoCmd.OpenQuery "Summary Time and Attendance Register", acViewNormal

End If
End Sub

Just not sure of where to " Now set the querydef's sql statement to strSQL"
Or even if the code is in the correct place.

Once again, thank you for your help!

 

[DBLoser]

I tried this code and it works Excellent! Except for when I convert the text boxes to combo boxes. Here's the situation, I have the following fields:

txtLaborDate_BeginR
Tag = Where=LaborMain.ClockInDat,Date;
txtLaborDate_EndR
Tag =
txtGroup
Tag = Where=LaborMain.Group,String;
txtOperation
Tag = Where=LaborMain.Operation,String;

Now these work great but when I change the Group and Operation TextBoxes to ComboBoxes based on queries, I get the following error when I hit the report button:

Run-time error '3075:
Missing ),], or Item in query expression '( (LaborMain.ClockInDat Between #11/1/2004 AND #11/12/2004 23:59:59#) AND (LaborMain.Group In('SILO', )'.

If I leave the comboboxes empty the report will generate without errors but includes all groups and operations.

I think an adjustment is needed to the Where= tag but I've tried adding ,Like and ,= after String but I get the same error either way. Or it is some other property of the combo boxes.

Thanks for any help!

 

[FancyPrairie]

Oooops! You found a bug. There's a line of code in the function "BuildWhere_ControlType" that needs to be changed. Change this

ElseIf (((ctl.ControlType = acTextBox) And (Right$(ctl.Name, Len(mstrcRange_End)) <> mstrcRange_End)) Or (ctl.ControlType = acComboBox) Or (ctl.ControlType = acOptionGroup) Or (ctl.ControlType = acCheckBox)) And (Not IsNull(ctl.Value)) And (Len(ctl.Value) > 0) And (ctl.Enabled) And (ctl.Visible) Then

to this

        ElseIf ((ctl.ControlType = acTextBox) Or (ctl.ControlType = acComboBox) Or (ctl.ControlType = acOptionGroup) Or (ctl.ControlType = acCheckBox)) And (Not IsNull(ctl.Value)) And (Len(ctl.Value) > 0) And (ctl.Enabled) And (ctl.Visible) Then
            
            If (Right$(ctl.Name, Len(mstrcRange_End)) = mstrcRange_End) Then GoTo ExitProcedure

 

[DBLoser]

I copied this code and replaced it in the module and inserted the combo boxes. I get an error now:

End If without Block If.

And this line was highlighted yellow:

Function BuildWhere_ControlType(frm As Form, ctl As Control) As String

With the last End If in that block of code as the stopping point.

I tried rem'ing it out but got a different error so I figured it was beyond me to fix it.

Thanks,

Bruce

 

[FancyPrairie]

You did something wrong. Because I just did it and it worked. Any way, replace your version of the Function BuildWhere_ControlType with this:

Function BuildWhere_ControlType(frm As Form, ctl As Control) As String

'********************************
'*  Declaration Specifications  *
'********************************

    Dim strTemp As String       'Working variable

'****************
'*  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="
    
        If (ctl.ControlType = acListBox) Then
            
            If (ctl.MultiSelect) And (ctl.ItemsSelected.Count > 0) And (ctl.Enabled) And (ctl.Visible) Then BuildWhere_ControlType = "ListBox"
            If (Not ctl.MultiSelect) And (Not IsNull(ctl.Value)) And (ctl.Enabled) And (ctl.Visible) Then BuildWhere_ControlType = "ListBox"
               
        ElseIf ((ctl.ControlType = acTextBox) Or (ctl.ControlType = acComboBox) Or (ctl.ControlType = acOptionGroup) Or (ctl.ControlType = acCheckBox)) And (Not IsNull(ctl.Value)) And (Len(ctl.Value) > 0) And (ctl.Enabled) And (ctl.Visible) Then
            
            If (Right$(ctl.Name, Len(mstrcRange_End)) = mstrcRange_End) Then GoTo ExitProcedure
            
            If (Right$(ctl.Name, Len(mstrcRange_Begin)) = mstrcRange_Begin) Then
                On Error GoTo 0
                If (Not BuildWhere_ValidRange(frm, ctl)) Then Err.Raise vbObjectError + 2002, "BuildWhere_ControlType", "Incomplete Range Specifications." & vbCrLf & vbCrLf & "You failed to enter/select a value for " & ctl.Name
                On Error GoTo ErrHandler
                
                BuildWhere_ControlType = "Range"
            
            ElseIf (ctl.ControlType = acTextBox) Then
                BuildWhere_ControlType = "TextBox"
            ElseIf (ctl.ControlType = acComboBox) Then
                BuildWhere_ControlType = "ComboBox"
            ElseIf (ctl.ControlType = acOptionGroup) Then
                BuildWhere_ControlType = "OptionGroup"
            ElseIf (ctl.ControlType = acCheckBox) Then
                BuildWhere_ControlType = "CheckBox"
            End If
        
        End If
    
    End If
    
'********************
'*  Exit Procedure  *
'********************
        
ExitProcedure:

    Exit Function

'****************************
'*  Error Recovery Section  *
'****************************
        
ErrHandler:
    
    Err.Raise Err.Number, "BuildWhere_ControlType;" & Err.Source, Err.Description
    
End Function

 

[DBLoser]

FancyPrairie,

First of all, thanks for your help!

I finally got some time to play with this. I recreated the whole mess, imported the original BuildWhere code and then replaced the BuildWhere_ControlType Function with your new code. I still cannot get it to work properly.

I started with two text boxes, Date_BeginR and Date_EndR. By themselves these work perfectly. I added a third textbox and set its tag to: Where=labor.group,String;

It will successfully filter out the proper group but it ignores the start and finish dates.

Next, replaced the group textbox with a combo box and set the tag to: Where=labor.group,String; and I get the same error message as before:

Run-time error '3075:
Missing ),], or Item in query expression '( (LaborMain.ClockInDat Between #11/1/2004 AND #11/22/2004 23:59:59#) AND (LaborMain.Group In('SILO', )'.

I'll post my button code and the BuildWhere code so you can tell if I replaced something wrong.

Here's the button code and this is where the stop occurs when I use the combo box:

Private Sub ViewReport_Click()
DoCmd.OpenReport "labor", acViewPreview, , BuildWhere(Me, " OR ")
End Sub

Here is the buildwhere code I'm using, which should be identical to what you have given:

Option Compare Database

Option Explicit

'*******************************************
'* Constant Declarations for this module *
'*******************************************

Const mstrcTagID As String = "Where=" 'Tag Property identifier to build Where Clause
Const mstrcRange_Begin As String = "_BeginR" 'String to be appended to the base name of a control that represents the Begin part of a range
Const mstrcRange_End As String = "_EndR" 'String to be appended to the base name of a control that represents the End part of a range
Const mstrcDateSymbol = "#" 'Symbol for dates (i.e. Date = #10/24/2004#)
Const mstrcFldSeparator = "," 'Separates items with Where= Tag
Const mstrcStringSymbol = "'" 'Symbol for strings (i.e. where name = 'dog')
Const mstrcTagSeparator = ";" 'Separates Tag items in controls Tag Property

'+********************************************************************************************
'*
'$ Function: BuildWhere
'*
'* Author: FancyPrairie
'*
'* Date: October, 1998
'*
'* Purpose: This routine will build a Where clause based on the items the user selected/entered on a
'* Report Criteria form (or any type of form that the caller may use to build a Where clause
'* based on the items selected).
'*
'* This routine assumes that, in order for the control to be included in the criteria,
'* it must satisfy the following conditions:
'*
'* 1. Tag Property must contain: Where=TableName.FieldName,FieldType[,Operator,Value]
'* a. TableName.FieldName is the name of the Table and field to filter on
'* (example: tblEmployee.lngEmpID)
'* b. FieldType must be one of the following words: String, Date
'* (Note: String and Date are the only ones that have special meaning at this time
'* (' or #). However, if the FieldType is not String or Date then set
'* you can leave the FieldType empty or (anticipating future uses) set the FieldType
'* to Long, Integer, Byte, Single, Double, Boolean.)
'* c. Operator (optional) can be one of the following: = <> < > <= >= Like IsNull
'* (Default is =)
'* d. Value (optional) to be filtered on (more for option groups and check boxes)
'* (Note: This is primarily intended to be used by Option groups and check boxes.
'* For example, suppose you have a check box. If the box is checked, then
'* the you need to set the Value argument equal to True and the FieldType
'* should be set to Boolean. Else Value should be set to False.)
'* 2. Control must be Enabled
'* 3. Control must be visible
'* 4. If the control is part of a range, then the name of the control must end with
'* either _BeginR (begin range control) or _EndR (end range control)
'*
'* As of this writing, the following controls are checked:
'* 1. List Boxes (multiselect and single select)
'* 2. Ranges (2 controls that are grouped together (i.e. Begin and End Dates)
'* 3. Text Boxes
'* 4. Combo Boxes
'* 5. Option Groups
'* 6. Check Boxes
'*
'* Arguments: frm (form)
'* ----------
'* Represents the form (Report Criteria form) that contains the controls
'* from which the Where clause is to be created.
'*
'* varCtl (ParamArray)
'* -------------------
'* Indicates which controls you want checked. If this argument is missing then
'* this routine loops thru all of the controls on the form searching for the ones
'* whose tag property is set accordingly. Else it only checks the ones passed by the caller.
'*
'* Control Examples:
'*
'* ListBox
'* -------
'* Visible ........ Yes
'* Enabled ........ Yes
'* Multi Select ... None, Simple, or Extended
'* Tag ............ Where=tblEmployee.lngDepartmentID,Number;
'*
'* TextBox
'* -------
'* Visible ........ Yes
'* Enabled ........ Yes
'* Tag ............ Where=tblEmployee.dteBirth,Date,>;
'*
'* Range
'* -----
'* Text Box (Begin Date Range: Name must end with _BeginR)
'* Name ...... txtHireDate_BeginR
'* Visible ... Yes
'* Enabled ... Yes
'* Tag ....... Where=tblEmployee.dteHire,Date;
'*
'* Text Box (End Date Range: Name must end with _EndR)
'* Name ...... txtHireDate_BeginR
'* Visible ... Yes
'* Enabled ... Yes
'* Tag ....... (not used...function relies on tag property of BeginDateRange text box)
'*
'* Option Group
'* ------------
'* Visible ... Yes
'* Enabled ... Yes
'* Tag ....... Where=tblEmployee.lngID,Long,=,3;
'*
'* Check Boxes
'* -----------
'* Visible ... Yes
'* Enabled ... Yes
'* Tag ....... Where=tblEmployee.ysnActive,Boolean,=,True;
'*
'* Calling Example:
'* Docmd.OpenReport "rptYourReport",acViewPreview,,BuildWhere(Me, " OR ")
'*
'* or strWhere = BuildWhere(Me, " OR ")
'*
'-*********************************************************************************************************'
'
Function BuildWhere(frm As Form, strOp As String, ParamArray varCtl() As Variant)

'********************************
'* Declaration Specifications *
'********************************

Dim ctl As Control 'Control currently being processed
Dim ctlEndR As Control '2nd control of Range pair

Dim varItem As Variant 'Items within multiselect list box

Dim strAnd As String 'And or ""
Dim strAndOr As String 'Either "And" or "Or"
Dim strCtlType As String 'Control Type of control being processed (also see error handler)
Dim strFieldName As String 'Table.FieldName value
Dim strFieldType As String 'FieldType ' or #
Dim strFieldValue As String 'Value
Dim strOperator As String 'Operator (= <> > < etc)
Dim strSuffix As String 'Suffix to be appended at end of a string
Dim strWhere As String 'Where clause to be returned to caller

Dim i As Integer 'Working Variable

'****************
'* Initialize *
'****************

On Error GoTo ErrHandler

strWhere = vbNullString
strAnd = vbNullString

'**************************************
'* Begin loop thru controls on form *
'**************************************

If (UBound(varCtl) = -1) Then
For Each ctl In frm.Controls
GoSub CreateWhere
Next
Else
For i = 0 To UBound(varCtl)
Set ctl = varCtl(i)
GoSub CreateWhere
Next i
End If

'***********************
'* Save Where Clause *
'***********************

BuildWhere = strWhere

'********************
'* Exit Procedure *
'********************

ExitProcedure:

Exit Function

'*********************************************
'* Create Where Clause for current control *
'*********************************************

CreateWhere:

strCtlType = BuildWhere_ControlType(frm, ctl)

Select Case strCtlType

Case "Range": GoSub GetTag: GoSub BuildRange 'strWhere = strWhere & strAnd & BuildWhere_Range(frm, ctl)
Case "ListBox": GoSub GetTag: GoSub BuildListBox 'strWhere = strWhere & strAnd & BuildWhere_ListBox(frm, ctl)
Case "TextBox": GoSub GetTag: GoSub BuildTextBox 'strWhere = strWhere & strAnd & BuildWhere_TextBox(frm, ctl)
Case "OptionGroup": GoSub GetTag: GoSub BuildOptionGroup 'strWhere = strWhere & strAnd & BuildWhere_OptionGroup(frm, ctl)
Case "CheckBox": GoSub GetTag: GoSub BuildCheckBox 'strWhere = strWhere & strAnd & BuildWhere_CheckBox(frm, ctl)
Case "ComboBox": GoSub GetTag: GoSub BuildComboBox

End Select

If (Len(strWhere) > 0) Then strAnd = strOp

Return

'##########################################################################################
'# Retrieve Tag Items #
'##########################################################################################

GetTag:

strFieldName = BuildWhere_GetTag("FieldName", ctl.Tag)
If (Len(strFieldName) = 0) Then Err.Raise vbObjectError + 2000, "BuildWhere (GetTag);" & Err.Source, "Invalid Tag Property (" & ctl.Tag & ")" & vbCrLf & vbCrLf & "The Tag Property should look like this:" & vbCrLf & mstrcTagID & "TableName.FieldName" & mstrcFldSeparator & "FieldType[" & mstrcFldSeparator & "Operator]" & vbCrLf & vbCrLf & "(where FieldType is either String, Date, or Number and Operator (optional) is either =, <>, <, >, <=, >=, Like)"
strFieldType = BuildWhere_GetTag("FieldType", ctl.Tag)

strOperator = BuildWhere_GetTag("Operator", ctl.Tag)
strFieldValue = BuildWhere_GetTag("Value", ctl.Tag)

Return

'##########################################################################################
'# Build Range #
'##########################################################################################

BuildRange:

'**********************************************************
'* Determine control that represents the End date range *
'**********************************************************

On Error Resume Next

Set ctlEndR = frm(Left$(ctl.Name, Len(ctl.Name) - Len(mstrcRange_Begin)) & mstrcRange_End)

If (Err.Number = 2465) Then
On Error GoTo 0
Err.Raise vbObjectError + 2001, "BuildWhere (" & strCtlType & ");" & Err.Source, "Invalid Range" & vbCrLf & vbCrLf & "You have declared a text box that represents the Begin Range (" & ctl.Name & ") but you did not declare a control that represents the End Range (" & Left$(ctl.Name, Len(ctl.Name) - Len(mstrcRange_Begin)) & mstrcRange_End & ")"
End If

If (IsNull(ctlEndR)) Then
On Error GoTo 0
Err.Raise vbObjectError + 2002, "BuildWhere (" & strCtlType & ");" & Err.Source, "Invalid Range" & vbCrLf & vbCrLf & "Your entered a value for the Begin Range but failed to enter a value for the End Range."
End If

'*****************
'* Build Where *
'*****************

On Error GoTo ErrHandler

If (Len(strFieldValue) = 0) Then strFieldValue = CStr(ctl.Value)

If (strFieldType = "#") Then 'IFT, then Date Field
strWhere = strWhere & strAnd & " (" & strFieldName & " Between #" & strFieldValue & "# AND #" & ctlEndR.Value & " 23:59:59#) "
Else
strWhere = strWhere & strAnd & " (" & strFieldName & " Between " & strFieldType & strFieldValue & strFieldType & " AND " & strFieldType & ctlEndR.Value & strFieldType & ") "
End If

strAnd = strOp

Return

'##########################################################################################
'# List Box #
'##########################################################################################

BuildListBox:

'*******************************************
'* Determine Operator (=, >, Like, etc.) *
'*******************************************

strAndOr = vbNullString
If (Len(strOperator) > 0) Then
If (strOperator = "<>") Then strAndOr = " AND " Else strAndOr = " OR "
End If

If (Len(strOperator) = 0) Or (strOperator = "=") Then
strWhere = strWhere & strAnd & " (" & strFieldName & " In ("
strSuffix = ", "
Else
strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " "
strSuffix = ") " & strAndOr
End If


If (ctl.MultiSelect) Then
For Each varItem In ctl.ItemsSelected
strWhere = strWhere & strFieldType & ctl.Column(ctl.BoundColumn - 1, varItem) & strFieldType & strSuffix
Next varItem

strWhere = Mid(strWhere, 1, Len(strWhere) - Len(strSuffix)) & ")) "


Else
If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Column(ctl.BoundColumn - 1)
strWhere = strWhere & strFieldType & strFieldValue & strFieldType & strSuffix
End If

strAnd = strOp

Return

'##########################################################################################
'# Text Box #
'##########################################################################################

BuildTextBox:

If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Value

strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " " & strFieldType & strFieldValue & strFieldType & ") "

strAnd = strOp

Return

'##########################################################################################
'# Option Group #
'##########################################################################################

BuildOptionGroup:

If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Value

strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " " & strFieldType & strFieldValue & strFieldType & ") "
strAnd = strOp

Return

'##########################################################################################
'# Check Box #
'##########################################################################################

BuildCheckBox:

If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Value

strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " " & strFieldType & strFieldValue & strFieldType & ") "
strAnd = strOp

Return

'##########################################################################################
'# Combo Box #
'##########################################################################################

BuildComboBox:

'*******************************************
'* Determine Operator (=, >, Like, etc.) *
'*******************************************

strAndOr = vbNullString
If (Len(strOperator) > 0) Then
If (strOperator = "<>") Then strAndOr = " AND " Else strAndOr = " OR "
End If

If (Len(strOperator) = 0) Or (strOperator = "=") Then
strWhere = strWhere & strAnd & " (" & strFieldName & " In ("
strSuffix = ", "
Else
strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " "
strSuffix = ") " & strAndOr
End If

If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Column(ctl.BoundColumn - 1)
strWhere = strWhere & strFieldType & strFieldValue & strFieldType & strSuffix

strAnd = strOp

Return

'****************************
'* Error Recovery Section *
'****************************

ErrHandler:

Err.Raise Err.Number, "BuildWhere (" & strCtlType & ");" & Err.Source, Err.Description

End Function

'+********************************************************************************************
'*
'$ Function: BuildWhere_ControlType
'*
'* Author: FancyPrairie
'*
'* Date: April, 1998
'*
'* Purpose: This routine determines if a control should be included (valid) if it meets the following conditions:
'*
'* List Boxes
'* 1. Tag Property contains: Where=
'* 2. At least one item selected
'* 3. List Box is enabled
'* 4. List Box is visible
'*
'* Range
'* 1. Tag Property contains: Where=
'* 2. Name of control ends with "_Begin"
'* 3. Value of control is NOT Null
'* 4. Control is enabled
'* 5. Control is visible
'*
'* Text Box
'* 1. Tag Property contains: Where=
'* 2. Value of control is NOT Null
'* 3. Control is enabled
'* 4. Control is visible
'*
'* Combo Boxes
'* 1. Tag Property contains: Where=
'* 2. One item selected
'* 3. Combo Box is enabled
'* 4. Combo Box is visible
'*
'-********************************************************************************************
'
Function BuildWhere_ControlType(frm As Form, ctl As Control) As String

'********************************
'* Declaration Specifications *
'********************************

Dim strTemp As String 'Working variable

'****************
'* 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="

If (ctl.ControlType = acListBox) Then

If (ctl.MultiSelect) And (ctl.ItemsSelected.Count > 0) And (ctl.Enabled) And (ctl.Visible) Then BuildWhere_ControlType = "ListBox"
If (Not ctl.MultiSelect) And (Not IsNull(ctl.Value)) And (ctl.Enabled) And (ctl.Visible) Then BuildWhere_ControlType = "ListBox"

ElseIf ((ctl.ControlType = acTextBox) Or (ctl.ControlType = acComboBox) Or (ctl.ControlType = acOptionGroup) Or (ctl.ControlType = acCheckBox)) And (Not IsNull(ctl.Value)) And (Len(ctl.Value) > 0) And (ctl.Enabled) And (ctl.Visible) Then

If (Right$(ctl.Name, Len(mstrcRange_End)) = mstrcRange_End) Then GoTo ExitProcedure

If (Right$(ctl.Name, Len(mstrcRange_Begin)) = mstrcRange_Begin) Then
On Error GoTo 0
If (Not BuildWhere_ValidRange(frm, ctl)) Then Err.Raise vbObjectError + 2002, "BuildWhere_ControlType", "Incomplete Range Specifications." & vbCrLf & vbCrLf & "You failed to enter/select a value for " & ctl.Name
On Error GoTo ErrHandler

BuildWhere_ControlType = "Range"

ElseIf (ctl.ControlType = acTextBox) Then
BuildWhere_ControlType = "TextBox"
ElseIf (ctl.ControlType = acComboBox) Then
BuildWhere_ControlType = "ComboBox"
ElseIf (ctl.ControlType = acOptionGroup) Then
BuildWhere_ControlType = "OptionGroup"
ElseIf (ctl.ControlType = acCheckBox) Then
BuildWhere_ControlType = "CheckBox"
End If

End If

End If

'********************
'* Exit Procedure *
'********************

ExitProcedure:

Exit Function

'****************************
'* Error Recovery Section *
'****************************

ErrHandler:

Err.Raise Err.Number, "BuildWhere_ControlType;" & Err.Source, Err.Description

End Function



'+********************************************************************************************
'*
'$ Function: BuildWhere_ValidRange
'*
'* Author: FancyPrairie
'*
'* Date: April, 1998
'*
'* Purpose: Determines if the values of 2 controls, that represent ranges, are valid. They are not valid
'* if one or both controls do not contain a value. For example, the user may have entered a begin
'* date, but failed to enter an end date.
'*
'* Arguments: frm (form)
'* ----------
'* Form that contains the controls to be processed.
'*
'* avarParControls (variant Parameter Array)
'* -----------------------------------------
'* List of contol(s) to be processed. If this array is empty, then this routine will
'* retrieve all of the "valid" controls on the form specified.
'*
'-********************************************************************************************
'
Function BuildWhere_ValidRange(frm As Form, ctl As Control) As Boolean

'********************************
'* Declaration Specifications *
'********************************

Dim ctlEnd As Control

'******************************************************************
'* Create array with just those text boxes that meet the specs. *
'******************************************************************

On Error GoTo ErrHandler

Set ctlEnd = frm(Left(ctl.Name, Len(ctl.Name) - Len(mstrcRange_Begin)) & mstrcRange_End)

If (IsNull(ctl)) Or (Len(ctl) = 0) Or (IsNull(ctlEnd)) Or (Len(ctlEnd) = 0) Then
BuildWhere_ValidRange = False
Else
BuildWhere_ValidRange = True
End If

'********************
'* Exit Procedure *
'********************

ExitProcedure:

Exit Function

'****************************
'* Error Recovery Section *
'****************************

ErrHandler:

Err.Raise Err.Number, "BuildWhere_ValidRange;" & Err.Source, Err.Description

End Function

'+********************************************************************************************
'*
'$ Function: BuildWhere_GetTag
'*
'* Author: FancyPrairie
'*
'* Date: April, 1998
'*
'* Purpose: This routine will return the value for a given Tag Item. The caller specifies
'* which item they want returned. Possible items are:
'* 1. FieldName
'* 2. FieldType
'* 3. Operator
'* 4. Value
'*
'* Note that this routine assumes the Tag Property contains an item that is formatted as:
'* Where=TableName.TableField,FieldType[,Operator,Value].
'*
'* Arguments: strFunction (string)
'* --------------------
'* Can be one of: FieldName, FieldType, Operator, Value
'*
'* strTag (string)
'* ---------------
'* String that contains an item that is formatted as:
'* Where=TableName.TableField,FieldType[,Operator,Value].
'*
'-********************************************************************************************
'
Function BuildWhere_GetTag(strFunction As String, strTag As String) As String

'********************************
'* Declaration Specifications *
'********************************

Dim i As Integer 'Working variable
Dim j As Integer 'Working variable
Dim k As Integer 'Working variable

Dim strTemp As String 'Working variable
Dim var As Variant 'Working variable

On Error GoTo ErrHandler

'**************************************************************
'* 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

For i = 0 To UBound(var)

strTemp = Replace(CStr(var(i)), " ", vbNullString)

j = InStr(1, strTemp, mstrcTagID) 'Find "Where="

If (j = 1) Then 'If true, found "Where="

strTemp = CStr(var(i))
j = InStr(1, strTemp, "=")

var = Split(Mid(strTemp, j + 1), mstrcFldSeparator)

'***************
'* FieldName *
'***************

If (strFunction = "FieldName") Then
BuildWhere_GetTag = Trim(CStr(var(0)))

'***************
'* FieldType *
'***************

ElseIf (strFunction = "FieldType") Then
If (UBound(var) < 1) Then
BuildWhere_GetTag = vbNullString
Else
Select Case Trim(CStr(var(1)))
Case "String": BuildWhere_GetTag = mstrcStringSymbol
Case "Date": BuildWhere_GetTag = mstrcDateSymbol
Case Else: BuildWhere_GetTag = vbNullString
End Select
End If

'**************
'* Operator *
'**************

ElseIf (strFunction = "Operator") Then
If (UBound(var) < 2) Then BuildWhere_GetTag = "=" Else BuildWhere_GetTag = Trim(CStr(var(2)))

'***********
'* Value *
'***********

ElseIf (strFunction = "Value") Then
If (UBound(var) < 3) Then
BuildWhere_GetTag = vbNullString
Else
BuildWhere_GetTag = Trim(CStr(var(3)))
End If

End If

Exit Function

End If

Next i

'********************
'* Exit Procedure *
'********************

ExitProcedure:

Exit Function

'********************
'* Error Recovery *
'********************

ErrHandler:

Err.Raise Err.Number, "BuildWhere_GetTag;" & Err.Source, Err.Description

End Function

 

[Vogue]

This module seems to be just what I'm looking for....i'm just not sure how to use it.
I want to use a form with multiple checkboxes to filter the results of a report. My database is for a Customer Service Department and each complaint logged has one or more reasons/category of complaint attached to it e.g.Refund, Poor Customer Service, Incorrect Price etc. etc. These reasons for the complaint are captured by using checkboxes on a form linked to the main form.
I have created new form with all the categories listed as checkboxes and I would like the report to display results that match the categories selected on the form. So if only the Refund checkbox is checked then I only want to display results where customers complained about refunds. If two checkboxes are checked then I want to display results for those two categories only etc etc.
I copied the module referenced in this thread, but I'm really unsure about what should be done next.
I'm not sure

1)where to include the tag property (is it on the form used to run the report or in the checkboxes used to initially enter the reason of complaint)
2)how to create the query
3)how to execute the report

 

[FancyPrairie]

You want to enter the required information in the Tag property of each of your checkboxes. For example, suppose you created a query that just returned records where customers complained about refunds. And suppose that query looked like this:

Select * From MyCustomerTable Where ysnComplaintRefunds = True

Then the Tag property for that check box would look like this:
Where=[MyCustomerTable].[ysnComplainRefunds],CheckBox,=,True;

Focus on getting just one check box to work. Once it's working then you'll see how to handle the others.

 

[Vogue]

Here's what I have done so far...
I created a general query which shows everything. Then I made the Tag of the checkbox on the form:
Where=[tblbestservice].[chkbs_pooratt],CheckBox,=,True;
How do I go about running the report? Are there any changes to be made in the module?

 

[FancyPrairie]

Like this:

Docmd.OpenReport "rptYourReport",acViewPreview,,BuildWhere(Me," OR ")

 

[FancyPrairie]

If you're not sure whether or not BuildWhere is returning the correct value or not, in the OnClick event of the button the user selects to print the report enter the following code rather than the docmd.openreport

Msgbox BuildWhere Me," OR