Multiple parameter queries but if left blank, ignore it

Question

I'm trying to create an automated dashboard where users can select what type of report they want to run in Excel, which will then affect the types of parameters in cells which affect a query in MS Access (using the MS Query function).

My problem is that I cannot for the life of me work out how to make this work. For instance, the data table in Access has the following:

Col1 Col2    Col3    Col4

Date Apples  Pumpkin Cars
     Oranges Potato  Trucks
     Grapes

I want to be able to run the query with the following parameters so that only the below values are returned:

Date Apples Oranges Pumpkin Potato Cars

However, the next report that someone selects may have the following:

Date Apples Oranges Grapes Pumpkin Cars

Anyone know how I can make this work? Basically, if a parameter is not selected, return all of the values in the table.

I think I've managed to explain this properly!

What's the parameter based on? Why no `Trucks` or `Grapes` in the first table, and `Oranges` and `Grapes` in the second? — BruceWayne, Feb 28 '17 at 23:34
Apologies, I think I formatted it wrong. Updated. The parameters are based on business units, so the reports are customised specifically for a particular unit. Not all units need a report on Trucks, for example, but some may need Apples and Oranges, but only one may need grapes. The parameters are put into cells in Excel where ideally the parameters are read from. — jeden, Mar 01 '17 at 00:15
I believe we did something like what you need years ago. We had a form where the user selected a report, then a database table would look at which parameters were available and hide all the rest. The default was to select all (*) if parameter not provided. I could try and find the code if you think it may help you (or at least how it was implemented). — Wayne G. Dunn, Mar 01 '17 at 00:20
That sounds pretty similar to what I'm after! Would be great if you could find it! — jeden, Mar 01 '17 at 00:25
Are you planning on using a form to let a user run any report, with a variable number of parameters, or can this be focused on running one report with multiple parameters? — Wayne G. Dunn, Mar 01 '17 at 00:28
It's essentially a drop down list of reports that can be run, and each report has different parameters associated with it. — jeden, Mar 01 '17 at 00:47

score 0 · Answer 1 · answered Mar 01 '17 at 02:35

This will describe a simple method that provides one form (frmReportChooser) that allows a user to select any report. Once selected, user will be presented with the custom list of controls to filter that report, and allow the user to set values for any combination of filters.

The code below was extracted from the form we used and confidential names/info were removed.

Let me know if you have questions or issues.

This code uses the following two tables:

ctrlReports: ID, ReportName, ObjectName, BaseQueryName
ctrlReportOptions: ID, ReportName, OptionOrder, ControlName, COntrolTop, ControlLeft, SkipLabel (Y/N), ctlRecordSource (query for comboboxes)

Create the two tables
Create your form and controls (report combobox, selection criteria, reset button, run button)
For each control set the default value to: ="*" or whatever you need
Populate the two tables with the required data (options per report, formatting location, etc.)
Create a query for your report that uses selection criteria for allowed options like:

=[Forms]![frmReportChooser]![txtFiscalYear] (will have either the default '*' or the value you select/enter.

Form: frmReportChooser main subroutines

When user selects a report from comboBox 'cboChooseReport'

    Private Sub cboChooseReport_Change()
Dim strSQL      As String
Dim rs          As ADODB.Recordset
Dim i           As Integer
Dim iTop        As Integer
Dim iLeft       As Integer
Dim iLblTop     As Integer
Dim iLblLeft    As Integer
Dim iLblWidth   As Integer
Dim iTab        As Integer
Dim strLabel    As String

1000        On Error GoTo Error_Trap
1020        strSQL = "SELECT ctrlReportOptions.ControlName, 'lbl' & Mid([ControlName],4,99) AS LabelName, SkipLabel " & _
                "From ctrlReportOptions WHERE (((ctrlReportOptions.ID)<>0)) " & _
                "GROUP BY ctrlReportOptions.ControlName, 'lbl' & Mid([ControlName],4,99), SkipLabel;"
1080        Set rs = New ADODB.Recordset
1100        rs.Open strSQL, CurrentProject.Connection, adOpenDynamic

1120        Do While Not rs.EOF
1140            Me(rs!ControlName).visible = False
1160            If rs!skiplabel = False Then
1180                Me(rs!LabelName).visible = False
1200            End If
1220            rs.MoveNext
1240        Loop
1260        rs.Close

1280        iTop = 0
1300        iTab = 0

1301        If IsNull(Me.cboChooseReport.Column(3)) Or Me.cboChooseReport.Column(3) = "" Then
1302            MsgBox "The field where you select a report is either empty or is missing an internal ID number." & _
            vbCrLf & vbCrLf & _
            "Please be sure you have selected a report.", vbOKOnly, "Missing Parameter"
1303            GoTo Proc_Exit
1305        End If

1320        strSQL = "select * from ctrlReportOptions " & _
                        "where [ID] = " & Me.cboChooseReport.Column(3) & _
                        " order by OptionOrder;"
1380        Set rs = New ADODB.Recordset
1400        rs.Open strSQL, CurrentProject.Connection, adOpenDynamic

1420        If rs.EOF Then
1440            Me.cmdShowQuery.visible = True
1460            Me.lblReportCriteria.visible = False
1480            Me.cmdShowQuery.Left = 2000
1500            Me.cmdShowQuery.Top = 1500
1520            Me.cmdShowQuery.TabIndex = 1
1540            Me.cmdReset.visible = False
1560            rs.Close
1580            Set rs = Nothing
1600            GoTo Proc_Exit
1620        End If

1640        Me.lblReportCriteria.visible = True
1660        Do While Not rs.EOF
1680            If rs!skiplabel = False Then
1700                strLabel = "lbl" & Mid(rs!ControlName, 4)
1720                iLblWidth = Me.Controls(strLabel).Width
1740                Me(strLabel).Top = rs!ControlTop
1760                Me(strLabel).Left = rs!ControlLeft - (Me(strLabel).Width + 50)
1780                Me(strLabel).visible = True
1820            End If
1840            iTab = iTab + 1
1860            Me(rs!ControlName).Top = rs!ControlTop
1880            Me(rs!ControlName).Left = rs!ControlLeft
1900            Me(rs!ControlName).visible = True
1920            If Left(rs!ControlName, 3) <> "lbl" Then
1940                Me(rs!ControlName).TabIndex = iTab
1960            End If
1980            If Me(rs!ControlName).Top >= iTop Then
2000                iTop = rs!ControlTop + Me(rs!ControlName).Height          ' Save last one
2020            End If

2040            If Left(rs!ControlName, 3) <> "lbl" And Left(rs!ControlName, 3) <> "cmd" Then
2060                If Me(rs!ControlName).DefaultValue = "=""*""" Then
'
2080                ElseIf Left(Me(rs!ControlName).DefaultValue, 2) = "=#" And Right(Me(rs!ControlName).DefaultValue, 1) = "#" Then
2100                    i = Len(Me(rs!ControlName).DefaultValue)
'
2120                ElseIf Me(rs!ControlName).DefaultValue = "True" Then
'
2140                ElseIf Me(rs!ControlName).DefaultValue = "False" Then
'
2160                End If
2180            Else
2200                If Me(rs!ControlName).Top + Me(rs!ControlName).Height >= iTop     Then
2220                    iTop = rs!ControlTop + Me(rs!ControlName).Height          ' Save last one
2240                End If
2260            End If
2280            rs.MoveNext
2300        Loop
2320        rs.Close
2340        Set rs = Nothing

2360        If Me.cboChooseReport.Column(1) <> "<<my special report>>" Then
2380            Me.cmdShowQuery.visible = True
2400            Me.cmdShowQuery.Left = 2000
2420            Me.cmdShowQuery.Top = iTop + 300
2440            iTab = iTab + 1
2460            Me.cmdShowQuery.TabIndex = iTab
2480        Else
2500            Me.cmdShowQuery.visible = False
2520        End If
2540        Me.cmdReset.visible = True
2560        Me.cmdReset.Left = 5000
2580        Me.cmdReset.Top = iTop + 300
2600        Me.cmdReset.TabIndex = iTab + 1

2620 Proc_Exit:
2640        Exit Sub
2660 Error_Trap:
2680        Err.Source = "Form_frmReportChooser: cboChooseReport_Change  at Line: " & Erl
2700        DocAndShowError
2720        Resume Proc_Exit
2740        Resume Next
2760        Resume
End Sub

Private Sub cmdReset_Click()
1000    On Error GoTo Error_Trap
1020    Me.cboFiscalYear.value = Eval(Mid$(Me. cboFiscalYear.DefaultValue, 2))
1040    Me.cboPart.value = Eval(Mid$(Me.cboPart.DefaultValue, 2))

1220    Me.chkYesNo = False
. . . 
1560    Me.txtStartDate.value = Eval(Mid$(Me. txtStartDate.DefaultValue, 2, 10))
. . .
1660    Me.Requery
1680    Me.Refresh
1700 Proc_Exit:
1720    Exit Sub
1740 Error_Trap:
1760    Err.Source = "Form_frmReportChooser: cmdReset_Click  at Line: " & Erl
1780    DocAndShowError
1800    Resume Proc_Exit
1820    Resume Next
End Sub

When user clicks command button to generate the report: Private Sub cmdShowQuery_Click()

Dim qryBase                             As ADODB.Command     
Dim strQueryName                        As String
Dim strAny_Open_Reports                 As String              
Dim strOpen_Report                      As String              

1000    On Error GoTo Error_Trap
1020    If Not IsNull(Me.cboChooseReport.value) And Me.cboChooseReport.value <> " " Then
1040        strAny_Open_Reports = Any_Open_Reports()    ' Check if any reports already open                
1060        If Len(strAny_Open_Reports) = 0 Then                   
1080            If Me.cboChooseReport.value = "<your report name>" Then
1090                BuildReportCriteria
1100                If Me.chkYesNo = True Then
1120                    DoCmd.OpenReport "<your report name>", acViewPreview
1140                Else
1160                    DoCmd.OpenReport "<your report name>", acViewPreview
1180                End If
1200            ElseIf Me.cboChooseReport.value = "<your report name>" Then
1220                If IsNull(Me.txtFromDate) Or Not IsDate(Me.txtFromDate) Then
1240                    MsgBox "You must enter a valid From Date", vbOKOnly, "Invalid Date"
1260                    Exit Sub
1280                End If
1300                If IsNull(Me.txtToDate) Or Not IsDate(Me.txtToDate) Then
1320                    MsgBox "You must enter a valid To Date", vbOKOnly, "Invalid Date"
1340                    Exit Sub
1360                End If

1380                Me.txtStartDate = Me.txtFromDate
1400                Me.txtEndDate = Me.txtToDate
1420                DoCmd.OpenReport Me.cboChooseReport.value, acViewPreview
. . .
4200            Else
4220                BuildReportCriteria
4240                If Me.cboChooseReport.value = "<your report name>"  Then
4280                    On Error Resume Next
4300                    DoCmd.DeleteObject acTable, "<my temp table>"
4320                    On Error GoTo Error_Trap
4340                    Set qryBase = New ADODB.Command
4360                    qryBase.ActiveConnection = gv_DBS_Local
4380                    qryBase.CommandText = ("<my make table query>")
4400                    qryBase.CommandType = adCmdStoredProc
4420                    qryBase.Execute
4440                ElseIf Me.cboChooseReport.value = "<your report name>" Then
4460                    On Error Resume Next
4480                    DoCmd.DeleteObject acTable, "My_temp"
4500                    On Error GoTo Error_Trap
4520                    Set qryBase = New ADODB.Command
4540                    qryBase.ActiveConnection = gv_DBS_Local
4560                    qryBase.CommandText = ("<my make table query>")
4580                    qryBase.CommandType = adCmdStoredProc
4600                    qryBase.Execute

4720                End If
4730                DoCmd.Hourglass False
4740                DoCmd.OpenReport Me.cboChooseReport.value, acViewPreview
4760            End If
4780        Else
4800            MsgBox "You cannot open this form/report because you already have a form/report(s) open: " & _
                    vbCrLf & strAny_Open_Reports & _
                    vbCrLf & "Please close the open form/report(s) before continuing."

4860             strOpen_Report = Open_Report
4880             DoCmd.SelectObject acReport, strOpen_Report
4900             DoCmd.ShowToolbar "tbForPost"

4920        End If
4940    Else
4960         MsgBox "Please Choose Report", vbExclamation, "Choose Report"
4980    End If

5000    Exit Sub

5020 Error_Trap:
5030    Err.Source = "Form_frmReportChooser: cmdShowQuery_Click - Report: " & Nz(Me.cboChooseReport.value) & "    at Line: " & Erl
5040    If Err.Number = 2501 Then   ' MsgBox "You chose not to open this report.", vbOKOnly, "Report cancelled"
5060        Exit Sub
5080    ElseIf Err.Number = 0 Or Err.Number = 7874 Then
5100        Resume Next
5110    ElseIf Err.Number = 3146 Then   ' ODBC -- call failed -- can have multiple errors
Dim errLoop     As Error
Dim strError    As String
Dim Errs1       As Errors

    ' Enumerate Errors collection and display properties of each Error object.
5120    i = 1
      Set Errs1 = gv_DBS_SQLServer.Errors
5130        Err.Description = Err.Description & "; Err.Count = " & gv_DBS_SQLServer.Errors.Count & "; "
5140        For Each errLoop In Errs1
5150            With errLoop
5160                Err.Description = Err.Description & "Error #" & i & ":" & " ADO Error#" & .Number & _
                        " Description= " & .Description
5170                i = i + 1
5180            End With
5190        Next

5240    End If
5250    DocAndShowError
5260    Exit Sub
5270    Resume Next
5280    Resume
End Sub


Function BuildReportCriteria()
Dim frmMe           As Form
Dim ctlEach         As Control
Dim strCriteria     As String
Dim prp             As Property
Dim strSQL          As String
Dim rs              As ADODB.Recordset

1000    On Error GoTo Error_Trap

1020    strSQL = "select * from ctrlReportOptions " & _
            "where ID = " & Me.cboChooseReport.Column(3) & _
            " order by OptionOrder;"
1080    Set rs = New ADODB.Recordset
1100    rs.Open strSQL, CurrentProject.Connection, adOpenDynamic

1120    If rs.EOF Then
1140        strCriteria = "     Report Criteria:  None"
1160    Else
1180        strCriteria = "     Report Criteria:  "
1200    End If

1220    Do While Not rs.EOF
1240        Set ctlEach = Me.Controls(rs!ControlName)
1260        If ctlEach.ControlType = acTextBox Or ctlEach.ControlType = acComboBox Then
1280            If ctlEach.value <> "*" And ctlEach.Name <> "cboChooseReport" And ctlEach.Name <> "cboWhatever" Then
1300                strCriteria = strCriteria & ctlEach.Tag & " = " & ctlEach.value & " , "
1320            End If
1340         End If
1360        rs.MoveNext
1380    Loop
1400    rs.Close
1420    Set rs = Nothing

1440    If Me.chkYesNo = -1 Then
1460        strCriteria = strCriteria & "Non-zero balances only = Yes"
1480    Else
    'return string with all choosen criteria and remove last " , " from the end of string
1500        strCriteria = Left$(strCriteria, Len(strCriteria) - 3)
1520    End If
1540    fvstr_ReportCriteria = strCriteria
1580    Set ctlEach = Nothing
1600    Exit Function
1620 Error_Trap:
1640    If Err.Number = 2447 Then
1660        Resume Next
1680    End If
1700    Err.Source = "Form_frmReportChooser: BuildReportCriteria  at Line: " & Erl
1720    DocAndShowError
1740    Exit Function
1760    Resume Next
End Function

Multiple parameter queries but if left blank, ignore it

1 Answers1