Creating a report from multiple criteria (1 Viewer)

[PaulD2019]

Hi all,

We are short a couple of staff members in our office since staff members have left our company, I'm not going to lie but I am trying to import the functions of a database created by someone else before I re-joined the company that we don't have much contact with into a database that I created for our company projects to monitor staff exposure into a database I made that created data for all of our project information.

The database that someone else made is full of information that a lot of what is included we don't need & I want to streamline it so only the information that is actually required is included & import it into the database I created, importing only the required information is hopefully going to help make my job a bit easier, I am already working long hours to try & keep on top of what needs to be carried out.

I have been playing around with the code from the original database & I have created a sample database with the information & form I would like to import, I want to have a form like what is included in the sample database that I have uploaded where multiple criteria can be selected from the form "frmExposureReport", the button with the caption "Run Exposure Report" (cmdRun) is pressed & "rptExposureReport" is generated with only the information filtered by the form is included.

The button on the original database is below

Option Compare Database

Private Sub cmdClear_Click()
    txtName = ""
    txtOther = ""
    txtType = ""
    txtStart = Null
    txtEnd = Null
End Sub

Private Sub cmdClose_Click()
    DoCmd.BrowseTo acBrowseToForm, "frmAnalMain"
End Sub

Private Sub cmdRun_Click()
    Dim StartDate As Date
    Dim EndDate As Date
    Dim rptName As String
    Dim xOther As String
    
    'Set globals and variables for dates
    GBL_Start_Date = Nz(txtStart, #1/1/2001#)
    GBL_End_Date = Nz(txtEnd, #1/1/2099#)
    GBL_Name = Nz(txtName, "")
    GBL_Other = Nz(txtOther, "")
    GBL_Type = Nz(txtType, "")
    GBL_RptTitle = ""
    rptName = txtReport
    xOther = Nz(txtOther, "")
    
    'Check if fields are empty and set variables.
    If Nz(txtStart, "") = "" Then
        StartDate = #1/1/2001#
    Else
        StartDate = Format(txtStart, "mm/dd/yyyy")
    End If
    
    If Nz(txtEnd, "") = "" Then
        EndDate = #1/1/2099#
    Else
        EndDate = Format(txtEnd, "mm/dd/yyyy")
    End If
    
    'Define the report title based on criteria.
    If GBL_Start_Date <> #1/1/2001# Or GBL_End_Date <> #1/1/2099# Or Nz(txtName, "") <> "" Or Nz(txtOther, "") <> "" Then
        If Nz(txtName, "") <> "" Or Nz(txtOther, "") <> "" Or Nz(txtType, "") <> "" Then
            GBL_RptTitle = " For"
            If Nz(txtName, "") <> "" And Nz(txtOther, "") <> "" And Nz(txtType, "") <> "" Then
                GBL_RptTitle = GBL_RptTitle & " " & txtName & " And " & txtOther & " And " & txtType
            ElseIf Nz(txtOther, "") <> "" And Nz(txtType, "") <> "" Then
                GBL_RptTitle = GBL_RptTitle & " " & txtType & " And " & txtOther
            ElseIf Nz(txtName, "") <> "" And Nz(txtOther, "") <> "" Then
                GBL_RptTitle = GBL_RptTitle & " " & txtName & " And " & txtOther
            ElseIf Nz(txtName, "") <> "" And Nz(txtType, "") <> "" Then
                GBL_RptTitle = GBL_RptTitle & " " & txtName & " And " & txtType
            Else
                If Nz(txtName, "") <> "" Then
                    GBL_RptTitle = GBL_RptTitle & " " & txtName
                ElseIf Nz(txtOther, "") <> "" Then
                    GBL_RptTitle = GBL_RptTitle & " " & txtOther
                End If
            End If
        End If
        
        If GBL_Start_Date <> #1/1/2001# And GBL_End_Date <> #1/1/2099# Then
            GBL_RptTitle = GBL_RptTitle & " Between " & GBL_Start_Date & " And " & GBL_End_Date
        Else
            If GBL_Start_Date <> #1/1/2001# Then
                GBL_RptTitle = GBL_RptTitle & " After " & GBL_Start_Date
            ElseIf GBL_End_Date <> #1/1/2099# Then
                GBL_RptTitle = GBL_RptTitle & " Before " & GBL_End_Date
            End If
        End If
    End If
    
    'Run the report based on criteria.
    If rptName Like "*Personal*" Then

        Dim qd As QueryDef
        Set qd = CurrentDb.QueryDefs("qryAnnualsSub")
        qd.sql = "SELECT GetFinYear(Nz([tblProjectActivity].[FinishDate],#01/01/01#)) AS TimePeriod, Sum(-[Audit]) AS AuditCount, Sum(-[tblProjectActivity].[PersonalCarriedOut]) AS PersonalCount, tblProject.ProjectType, tblProjectActivity.Material FROM tblProjectActivity LEFT JOIN tblProject ON tblProjectActivity.ProjectID = tblProject.ProjectID" & _
                   " WHERE(((tblProjectActivity.Notifiable) = True)) And Material Like '*" & xOther & "*' And ProjectType Like '*" & txtType & "*'" & _
                    " GROUP BY GetFinYear(Nz([tblProjectActivity].[FinishDate],#01/01/01#)), tblProject.ProjectType, tblProjectActivity.Material" & _
                     " HAVING (((GetFinYear(Nz([tblProjectActivity].[FinishDate],#01/01/01#))) >= '" & GetFinYear(StartDate) & "' And (GetFinYear(Nz([tblProjectActivity].[FinishDate],#01/01/01#))) <= '" & GetFinYear(EndDate) & "'));"
        
        DoCmd.OpenReport rptName, acViewPreview, , "PersonalName Like '*" & txtName & "*' And PersonalDate Between #" & StartDate & "# And #" & EndDate & "# And Nz(Material,"""") Like '*" & xOther & "*' And ProjectType Like '*" & txtType & "*'"

    ElseIf rptName Like "*Exposure*" Then
        DoCmd.OpenReport rptName, acViewPreview, , "Name Like '*" & txtName & "*' And ItemDate >= #" & StartDate & "# And ItemDate <= #" & EndDate & "# And ProjectType Like '*" & txtType & "*'"
    End If
    
End Sub

Also the below code is included

Option Compare Database

Global GBL_Start_Date As Date
Global GBL_End_Date As Date
Global GBL_Name As String
Global GBL_Other As String
Global GBL_Type As String
Global GBL_RptTitle As String

'----Sage login -------------
Global SAGEPath, SAGEPathHAD, SAGECompany, SAGEUser, SAGEpassword As String

Option Explicit

Public Function Get_Global(G_name As String) As Variant

     Select Case G_name
            
            Case "Start_Date"
                    Get_Global = GBL_Start_Date
                    
            Case "End_Date"
                    Get_Global = GBL_End_Date
                    
            Case "GBL_Name"
                    Get_Global = GBL_Name
            
            Case "GBL_Other"
                    Get_Global = GBL_Other
                    
            Case "GBL_Type"
                    Get_Global = GBL_Type
                    
            Case "GBL_RptTitle"
                    Get_Global = GBL_RptTitle
                  
    End Select
    
End Function

I need to modify the code above & get it imported into the attached database so "rptEmployeeExposure" is generated with the required information as our companies 3 monthly or yearly report for each material or project type that I will expand once working with other reports generated using the same method from other tables.

Any help will be appreciated to get the function on the database working

Thanks
PaulD2019

 

[plog]

That code is overkill and poor, I would not continue down the method you are pursuing. This function:

Public Function Get_Global(G_name As String) As Variant

is 100% unnecessary. It's a function that returns data in global variables. Global variables are just that Global--they are available everywhere. You've put a letter in an envelope in another envelope. Wherever you would want to use this function you should just instead use the Global variable. However...

Even the global variables serve no purpose, they shouldn't be global variables. They don't need to exist everywhere, just inside the function that is going to use them. A case could be made that they don't even need to be variables, just assign whatever value they will hold to the report inputs directly. Here's the broad strokes of what this function should look like:

Private Sub cmdRun_Click()
  ' handles clicking the run report button

str_Report = "rptEmployeeExposure"
str_Criteria = "(1=1)"
str_Title = "Your Title Here"

if IsNull(Me.textName) = False Then str_Criteria = str_Criteria & " AND (EmployeeName ='" & Me.textName & "')"
  ' if user supplied name to limit to, uses that on report 

if IsDate(Me.textStart) = True Then str_Criteria = str_Criteria & " AND (RemovalDate >= #'" & Me.textStart & "#)"
  ' if user supplied start date to limit to, uses that on report 


' add more criteria here

DoCmd.OpenReport str_Report, acViewPreview, , str_Criteria
  ' opens report and applies criteria

   Screen.ActiveReport.ReportTitle.Visible = True
   Screen.ActiveReport.ReportTitle.Caption = str_Titlle
  ' sets title of report

End Sub

You just add more lines for each criteria input and then any code you need to control the Report Title.

 

[PaulD2019]

Thank you for your help & advice @plog

 

[PaulD2019]

I have added the other lines & renamed as required, I haven't worked on adding the code to add the code to control the report title yet.

The code works fine with one, two or all three of the combo boxes when populated, unfortunately it doesn't work with the start & finish date fields, when trying to use those I get a Run-time error '3075'; error

Syntax error in date in query expression '((1=1) AND (EmployeeName =") AND (RemovalDate >= #'01/03/2023#) AND (RemovalType =") And (ProjectType =")'.

When viewing the code it shows the error on the part of the code that opens the report

DoCmd.OpenReport str_Report, acViewPreview, , str_Criteria

I thought after looking online that it was just a missing apostrophe, I tried adding one in a few locations on the date parts of the code but it still didn't work.

Here is the code how I have it now

Private Sub cmdRun_Click()
  ' handles clicking the run report button

str_Report = "rptEmployeeExposure"
str_Criteria = "(1=1)"
str_Title = "Exposure Report"

If IsNull(Me.txtName) = False Then str_Criteria = str_Criteria & " AND (EmployeeName ='" & Me.txtName & "')"
  ' if user supplied name to limit to, uses that on report

If IsDate(Me.txtStart) = True Then str_Criteria = str_Criteria & " AND (RemovalDate >= #'" & Me.txtStart & "#)"
  ' if user supplied start date to limit to, uses that on report

If IsDate(Me.txtEnd) = True Then str_Criteria = str_Criteria & " AND (RemovalDate =< #'" & Me.txtEnd & "#)"
  ' if user supplied end date to limit to, uses that on report

If IsNull(Me.txtOther) = False Then str_Criteria = str_Criteria & " AND (RemovalType ='" & Me.txtOther & "')"
  ' if user supplied name to limit to, uses that on report

If IsNull(Me.txtType) = False Then str_Criteria = str_Criteria & " AND (ProjectType ='" & Me.txtType & "')"
  ' if user supplied name to limit to, uses that on report

DoCmd.OpenReport str_Report, acViewPreview, , str_Criteria
  ' opens report and applies criteria


End Sub

Any more help with this that anyone could give would be appreciated.

Thank you

 

[plog]

The problem is that while the fields aren't NULL, they are empty (there's a difference). So what we need to do is test for both. You should change the IsNulls like this:

Current:
If IsNull(Me.txtName) = False Then ...

Change to:
If NZ(Me.txtName, '')='' Then ...


For clarification, those are two single quotes (or apostrophes), not one double quote. That will make sure the code will not trigger if the values are NULL or empty strings.

 

[PaulD2019]

Hi @plog & thanks for your reply again

I take it I had to change to the above on just the lines of code for the Combo Boxes?

If so I added that but all three lines are now red & show as Compile error: Syntax error

Below is the code in case I have added it wrong

Private Sub cmdRun_Click()
  ' handles clicking the run report button

str_Report = "rptEmployeeExposure"
str_Criteria = "(1=1)"
str_Title = "Exposure Report"

If NZ(Me.txtName, '')='' Then str_Criteria = str_Criteria & " AND (EmployeeName ='" & Me.txtName & "')"
  ' if user supplied name to limit to, uses that on report

If IsDate(Me.txtStart) = True Then str_Criteria = str_Criteria & " AND (RemovalDate >= #'" & Me.txtStart & "#)"
  ' if user supplied start date to limit to, uses that on report

If IsDate(Me.txtEnd) = True Then str_Criteria = str_Criteria & " AND (RemovalDate =< #'" & Me.txtEnd & "#)"
  ' if user supplied end date to limit to, uses that on report

If NZ(Me.txtOther, '')='' Then str_Criteria = str_Criteria & " AND (RemovalType ='" & Me.txtOther & "')"
  ' if user supplied name to limit to, uses that on report

If NZ(Me.txtType, '')='' Then str_Criteria = str_Criteria & " AND (ProjectType ='" & Me.txtType & "')"
  ' if user supplied name to limit to, uses that on report

DoCmd.OpenReport str_Report, acViewPreview, , str_Criteria
  ' opens report and applies criteria


End Sub

 

[plog]

Sorry I was trying to freehand it. I fired up your database and actually put the code in and made it work. Use this:

Private Sub cmdRun_Click()
str_Report = "rptEmployeeExposure"
str_Criteria = "(1=1)"
str_Title = "Exposure Report"

If Nz(Me.txtName, "") <> "" Then str_Criteria = str_Criteria & " AND (EmployeeName ='" & Me.txtName & "')"
  ' if user supplied name to limit to, uses that on report

If IsDate(Me.txtStart) = True Then str_Criteria = str_Criteria & " AND (RemovalDate >= #'" & Me.txtStart & "#)"
  ' if user supplied start date to limit to, uses that on report

If IsDate(Me.txtEnd) = True Then str_Criteria = str_Criteria & " AND (RemovalDate =< #'" & Me.txtEnd & "#)"
  ' if user supplied end date to limit to, uses that on report

If Nz(Me.txtOther, "") <> "" Then str_Criteria = str_Criteria & " AND (RemovalType ='" & Me.txtOther & "')"
  ' if user supplied name to limit to, uses that on report

If Nz(Me.txtType, "") <> "" Then str_Criteria = str_Criteria & " AND (ProjectType ='" & Me.txtType & "')"
  ' if user supplied name to limit to, uses that on report


DoCmd.OpenReport str_Report, acViewPreview, , str_Criteria
  ' opens report and applies criteria
   
End Sub

Instead of single quotes I should have used double quotes. Also, I didn't want = I wanted <>. The above code should work when pasted.

 

[PaulD2019]

Hi @plog

I tried pasting the code in & it is still only working on the combo boxes, error on the date fields still for me.

With the combo boxes when filled & the cmd button is pressed I am now getting a msgbox open up that list what the filter is, once I click on ok the report opens with the list filtered.

I have uploaded my test database with the code changed so you can see.

Thanks for your continued help

 

[plog]

Try these lines instead:

If IsDate(Me.txtStart) = True Then str_Criteria = str_Criteria & " AND (RemovalDate >= #" & Me.txtStart & "#)"
  ' if user supplied start date to limit to, uses that on report

If IsDate(Me.txtEnd) = True Then str_Criteria = str_Criteria & " AND (RemovalDate <= #" & Me.txtEnd & "#)"
  ' if user supplied end date to limit to, uses that on report

Had an errant apostrophe and the wrong sign on one of them.

 

[PaulD2019]

No joy with that either,

A msgbox opens listing the filter to be applied still, I can't see why as it wasn't doing that before. When I click on ok the report now opens without an error but the list on the report isn't filtered, sorry

 

[Josef P.]

Depending on the country setting, the date should be formatted SQL compliant.

Const IsoDateFormat As String = "\#yyyy-mm-dd\#"
If IsDate(Me.txtStart) = True Then str_Criteria = str_Criteria & " AND (RemovalDate >= " & Format(Me.txtStart, IsoDateFormat) & ")"
  ' if user supplied start date to limit to, uses that on report

If IsDate(Me.txtEnd) = True Then str_Criteria = str_Criteria & " AND (RemovalDate <= " & Format(Me.txtEnd, IsoDateFormat) & ")"
  ' if user supplied end date to limit to, uses that on report

A msgbox opens listing the filter to be applied still, I can't see why as it wasn't doing that before.

Most of the time, what is written in the code is done.

Private Sub cmdRun_Click()
[....]
MsgBox (str_Criteria)

DoCmd.OpenReport str_Report, acViewPreview, , str_Criteria
  ' opens report and applies criteria

End Sub

[OT]
MsgBox (str_Criteria) ... do you see the space between MsgBox and (?
use MsgBox str_Criteria or returnValue = MsgBox(str_Criteria) or Call MsgBox(str_Criteria)
... try with 2 params: MsgBox ("?", vbCritical)

 

[PaulD2019]

Hi @Josef P.

Thanks for joining in to help!

The code is now working with the date fields

Is there a way to stop the msgboxes from opening showing what filter is being applied?

 

[plog]

Get rid of the call to MsgBox in the code

 

[PaulD2019]

Get rid of the call to MsgBox in the code

Sorry @plog I hadn't noticed that had been added in

Thank you so much @plog & @Josef P. for helping & getting this working for me.

More building of the new modified database & importing everything in, this is really going to help make my life easier with my current overloaded work load

 

[PaulD2019]

Hi all,

Work has been really busy but as I was off work today I actually got around to making a form in the updated version of the database that I have been working on, I've added an additional combo box to add another criteria to the form, added a field on the form to build the title of the header on the report, created a query for the data included in the report then I created the report itself & everything is working fine filtering the report & the report opens in preview mode using the below code

Private Sub cmdRun_Click()
str_Report = "rptPersonalReport"
str_Criteria = "(1=1)"
Const IsoDateFormat As String = "\#yyyy-mm-dd\#"

If Nz(Me.cboEmployeeName, "") <> "" Then str_Criteria = str_Criteria & " AND (PersonalName ='" & Me.cboEmployeeName & "')"
  ' if user supplied name to limit to, uses that on report

If IsDate(Me.txtStart) = True Then str_Criteria = str_Criteria & " AND (PersonalDate >= " & Format(Me.txtStart, IsoDateFormat) & ")"
  ' if user supplied start date to limit to, uses that on report

If IsDate(Me.txtEnd) = True Then str_Criteria = str_Criteria & " AND (PersonalDate <= " & Format(Me.txtEnd, IsoDateFormat) & ")"
  ' if user supplied end date to limit to, uses that on report

If Nz(Me.cboProjectType, "") <> "" Then str_Criteria = str_Criteria & " AND (ProjectType ='" & Me.cboProjectType & "')"
  ' if user supplied name to limit to, uses that on report

If Nz(Me.cboMaterialType, "") <> "" Then str_Criteria = str_Criteria & " AND (Material ='" & Me.cboMaterialType & "')"
  ' if user supplied name to limit to, uses that on report

If Nz(Me.cboMaskType, "") <> "" Then str_Criteria = str_Criteria & " AND (PersonalRPEWorn ='" & Me.cboMaskType & "')"
  ' if user supplied name to limit to, uses that on report

DoCmd.OpenReport str_Report, acViewPreview, , str_Criteria
  ' opens report and applies criteria
  
End Sub

All of the other reports that are generated from the databases that I have made rather than open in preview mode create a .pdf file which saves in a specific folder on the server in my office, none of the reports have specified criteria, they only generate & show data from the table/query that the form is generated from.

I want to do the same with this report, I have tried modifying the code above with the code I use for the other reports but I can't get it working, the code I tried is below

Private Sub cmdRun_Click()
str_Report = "rptPersonalReport"
str_Criteria = "(1=1)"
Const IsoDateFormat As String = "\#yyyy-mm-dd\#"
Dim FileName As String
Dim FilePath As String

If Nz(Me.cboEmployeeName, "") <> "" Then str_Criteria = str_Criteria & " AND (PersonalName ='" & Me.cboEmployeeName & "')"
  ' if user supplied name to limit to, uses that on report

If IsDate(Me.txtStart) = True Then str_Criteria = str_Criteria & " AND (PersonalDate >= " & Format(Me.txtStart, IsoDateFormat) & ")"
  ' if user supplied start date to limit to, uses that on report

If IsDate(Me.txtEnd) = True Then str_Criteria = str_Criteria & " AND (PersonalDate <= " & Format(Me.txtEnd, IsoDateFormat) & ")"
  ' if user supplied end date to limit to, uses that on report

If Nz(Me.cboProjectType, "") <> "" Then str_Criteria = str_Criteria & " AND (ProjectType ='" & Me.cboProjectType & "')"
  ' if user supplied name to limit to, uses that on report

If Nz(Me.cboMaterialType, "") <> "" Then str_Criteria = str_Criteria & " AND (Material ='" & Me.cboMaterialType & "')"
  ' if user supplied name to limit to, uses that on report

If Nz(Me.cboMaskType, "") <> "" Then str_Criteria = str_Criteria & " AND (PersonalRPEWorn ='" & Me.cboMaskType & "')"
  ' if user supplied name to limit to, uses that on report

FileName = "Personal Report"
FilePath = "C:\Users\pauld\Desktop\Temp Files\" & FileName & ".pdf"

DoCmd.OutputTo acOutputReport, str_Report, acFormatPDF, FilePath, acViewPreview, , str_Criteria
MsgBox FileName & Chr(10) & " " & Chr(13) & Chr(10) & "Has been saved successfully to " & Chr(10) & " " & Chr(13) & Chr(10) & FilePath, vbInformation, "Save Confirmed"
End Sub

Nothing happens when I press the button, I have tried a few different things like changing "str_Report" in the Docmd line to the actual name of the report which has the same result, no .pdf file is generated.

Just as a test I removed ", , str_Criteria" from the below line of code

DoCmd.OutputTo acOutputReport, str_Report, acFormatPDF, FilePath, acViewPreview

With that gone it generates a .pdf report saved in a folder like my others do but obviously the report isn't filtered by the criteria. I have also tried moving the location of ", , str_Criteria" in the line but it doesn't make any difference so I am stumped on why it isn't working.

Any more help that anyone can give would be appreciated.

 

[plog]

OutputTo doesn't take criteria, but it will export an opened report that has had criteria applied. With a little trickery, the user will never see it open and will just think it exported:

DoCmd.OpenReport str_Report, acViewPreview, , str_Criteria, acHidden
DoCmd.OutputTo acOutputReport, str_Report, acFormatPDF, FilePath, acViewPreview
DoCmd.Close acReport, str_Report, acSaveNo

Of course, I'd really question if this is really a workflow you want to implement. I mean now the user doesn't get to preview the report or dictate where its saved. And if they want to view its contents they must now find and open that .pdf instead of just viewing it on their screen when they click that 'Run Report' button.. I would think its a better idea to preview the report in Access then let the user save it wherever they want, if in fact, they do want to save it at all.

 

[PaulD2019]

That works, thank you @plog

 

[PaulD2019]

Of course, I'd really question if this is really a workflow you want to implement. I mean now the user doesn't get to preview the report or dictate where its saved. And if they want to view its contents they must now find and open that .pdf instead of just viewing it on their screen when they click that 'Run Report' button.. I would think its a better idea to preview the report in Access then let the user save it wherever they want, if in fact, they do want to save it at all.

It is what is needed & previewing isn't required, the report will be used to record & save the data on a 3 monthly basis for various material types that our staff remove, it doesn't need to be previewed first as it collates data that has been added on one of the forms of the database, I will add additional criteria to the FileName so the name of each pdf file that is generated is unique.

Thank you again for helping solve my problem.