Link to home
Start Free TrialLog in
Avatar of rogerdjr
rogerdjrFlag for United States of America

asked on

apply a filter to a subreport in a report with vba

Access VBA - looking for a way to apply a filter to a subreport in a report with vba or alternately a way to change the record  source for a subreport with vba
Avatar of Gustav Brock
Gustav Brock
Flag of Denmark image

This has been dealt with here before:

Setting filter on sub report
Avatar of rogerdjr

ASKER

Tried entering this code in the Parent form detail format event


    If Not IsNull(WkgWklyMtgRptFilter) Then
        Me![81_ConstrMtgNotesWkgPhotLstSubRpt].Report.Filter = WkgWklyMtgRptFilter '01-11-2019
        Me![81_ConstrMtgNotesWkgPhotLstSubRpt].Report.FilterOn = True
    Else
        Me![81_ConstrMtgNotesWkgPhotLstSubRpt].Report.FilterOn = False
    End If

Get error message 2101 "the setting you entered isn't valid for this property"
WkgWklyMtgRptFilter should probably read:

"[YourDateField] = #2019/01/11#"

Open in new window

'01-11-2019 is just a comment

The filter WkgWklyMtgRptFilter is a public variable (string) that is set when the button on a form is clicked to open  the main report.

It works as a filter for the master parent form and I want apply the same filter to a couple of subreports
Then specify/add the field in the MasterLinkFields and ChildLinkFields of the subreport properties.
Then no code is needed at all.
I used that when the filter was simple but the filter looks like"

"([contractID] = "17029" or [contractID] = "17029.1" or [contractID] = "17029.2") and [MeetingID] - 18

And the number of contracts varies depending on the project, may be as few as one and as may as a dozen
ASKER CERTIFIED SOLUTION
Avatar of Gustav Brock
Gustav Brock
Flag of Denmark image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Tried that but the sub report is in the footer of the master report and only collect the data from the first contract
I inadvertently closed this question not sure how to re-open
I believe you can add new comments as needed.
Thanks

I initially tried linking the sub report as was suggested and it works fine when there is just one contract in the report filter. When I add multiple contracts in the filter it appears that because the sub report is in the footer of the master report and it only shows the data from the first contract

That is why I thought that if I could apply the filter to the subreport it might solve the problem

Thanks
Yes, then you will have to filter the subreport and remove master/child settings.
The simplest would be to filter the query that is used as recordsource for the subreport, or adjust the recordsource or the filter of the subreport when opening the main report.
I'll give that a try right now thanks
added this to the Report footer format

    StrSql = "SELECT [81_ConstrMtgNotesWkgPhotLstTbl].ContractId, [81_ConstrMtgNotesWkgPhotLstTbl].MtgNotesPhotLstRecId, [81_ConstrMtgNotesWkgPhotLstTbl].PhotoID, [81_ConstrMtgNotesWkgPhotLstTbl].RefFilePhoto, [81_ConstrMtgNotesWkgPhotLstTbl].PhotoImage, "
    StrSql = StrSql & "[81_ConstrMtgNotesWkgPhotLstTbl].TmeKeeperJobNo, [81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber, [81_ConstrMtgNotesWkgPhotLstTbl].MeetingDate, [81_ConstrMtgNotesWkgPhotLstTbl].Notes, [81_ConstrMtgNotesWkgPhotLstTbl].DateEntered, "
    StrSql = StrSql & "[81_ConstrMtgNotesWkgPhotLstTbl].DateRevised, [81_ConstrMtgNotesWkgPhotLstTbl].RevisedByUserId, 'Photo No ' & [81_ConstrMtgNotesWkgPhotLstTbl]![PhotoID] & ' Taken ' & [81_ConstrMtgNotesWkgPhotLstTbl]![PhotoDate] & ' (' & [81_ConstrMtgNotesWkgPhotLstTbl]![ContractId] & ')' AS PhotFootNote, "
    StrSql = StrSql & "[80_ConstrMtgListWkgTbl].MeetingGroupId FROM 81_ConstrMtgNotesWkgPhotLstTbl INNER JOIN 80_ConstrMtgListWkgTbl ON ([81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber = [80_ConstrMtgListWkgTbl].MeetingNumber) AND "
    StrSql = StrSql & "([81_ConstrMtgNotesWkgPhotLstTbl].ContractId = [80_ConstrMtgListWkgTbl].ContractId) WHERE ((([81_ConstrMtgNotesWkgPhotLstTbl].ContractId) = '17029.001-001') And (([81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber) = 18)) Or "
    StrSql = StrSql & "((([81_ConstrMtgNotesWkgPhotLstTbl].ContractId) = '17029.000-001') And (([81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber) = 18)) Or ((([81_ConstrMtgNotesWkgPhotLstTbl].ContractId) = '17029.002-001') And (([81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber) = 18)) "
    StrSql = StrSql & "ORDER BY [81_ConstrMtgNotesWkgPhotLstTbl].ContractId, [81_ConstrMtgNotesWkgPhotLstTbl].PhotoID, [81_ConstrMtgNotesWkgPhotLstTbl].DateEntered;"

   
    Reports![81_ConstrMtgNotesWkgRpt]![81_ConstrMtgNotesWkgPhotLstSubRpt].Report.RecordSource = StrSql

Got an error message that I cannot change record source to a subform once it started printing

Moved the same code to the report open got run-time error 2455 You entered an expression that has an invalid reference to the property form/report
Sounds right. The subreport hasn't been loaded when the report opens.

Then I would use a query as source for the subreport and, before opening the report, modify that query to filter on the ContractIDs.
How do I change the subreport query when its not open?
One method is to modify the SQL property of the query:

Dim qd As DAO.QueryDef
Dim Sql As String

Sql = "<your modified SQL sentence including the current where clause>"

Set qd = CurrentDb.QueryDefs("YourSubreportQueryName")
qd.SQL = Sql

' Open report.

Open in new window

I know its got to be something simple

I created this  and when I run it it returns item not found in collection?

Private Sub SubReportFilter()

Dim qd As dao.QueryDef
Dim Sql As String, StrSql As String

    StrSql = "SELECT [81_ConstrMtgNotesWkgPhotLstTbl].ContractId, [81_ConstrMtgNotesWkgPhotLstTbl].MtgNotesPhotLstRecId, [81_ConstrMtgNotesWkgPhotLstTbl].PhotoID, [81_ConstrMtgNotesWkgPhotLstTbl].RefFilePhoto, [81_ConstrMtgNotesWkgPhotLstTbl].PhotoImage, "
    StrSql = StrSql & "[81_ConstrMtgNotesWkgPhotLstTbl].TmeKeeperJobNo, [81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber, [81_ConstrMtgNotesWkgPhotLstTbl].MeetingDate, [81_ConstrMtgNotesWkgPhotLstTbl].Notes, [81_ConstrMtgNotesWkgPhotLstTbl].DateEntered, "
    StrSql = StrSql & "[81_ConstrMtgNotesWkgPhotLstTbl].DateRevised, [81_ConstrMtgNotesWkgPhotLstTbl].RevisedByUserId, 'Photo No ' & [81_ConstrMtgNotesWkgPhotLstTbl]![PhotoID] & ' Taken ' & [81_ConstrMtgNotesWkgPhotLstTbl]![PhotoDate] & ' (' & [81_ConstrMtgNotesWkgPhotLstTbl]![ContractId] & ')' AS PhotFootNote, "
    StrSql = StrSql & "[80_ConstrMtgListWkgTbl].MeetingGroupId FROM 81_ConstrMtgNotesWkgPhotLstTbl INNER JOIN 80_ConstrMtgListWkgTbl ON ([81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber = [80_ConstrMtgListWkgTbl].MeetingNumber) AND "
    StrSql = StrSql & "([81_ConstrMtgNotesWkgPhotLstTbl].ContractId = [80_ConstrMtgListWkgTbl].ContractId) WHERE "
'    StrSql = StrSql & WkgWklyMtgRptFilter
    StrSql = StrSql & "((([81_ConstrMtgNotesWkgPhotLstTbl].ContractId) = '17029.001-001') And (([81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber) = 18)) Or "
    StrSql = StrSql & "((([81_ConstrMtgNotesWkgPhotLstTbl].ContractId) = '17029.000-001') And (([81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber) = 18)) Or ((([81_ConstrMtgNotesWkgPhotLstTbl].ContractId) = '17029.002-001') And (([81_ConstrMtgNotesWkgPhotLstTbl].MeetingNumber) = 18)) "
    StrSql = StrSql & " ORDER BY [81_ConstrMtgNotesWkgPhotLstTbl].ContractId, [81_ConstrMtgNotesWkgPhotLstTbl].PhotoID, [81_ConstrMtgNotesWkgPhotLstTbl].DateEntered;"

Set qd = CurrentDb.QueryDefs("81_ConstrMtgNotesWkgPhotLstSubRpt")
qd.Sql = StrSql

End Sub

Open in new window


FYI this is the code I use for the button to open the report

Private Sub PreviewAgenda_Click()
    Dim dbs As Database, StrSql As String, Rst As Recordset, Rst1 As Recordset, Rst2 As Recordset, Rst3 As Recordset, Rstx As Recordset, ExceSmryRst As Recordset
    Dim CompositeFilter As String
    Dim SeqExt As Double, CloseDate As Date, PrevWk As Integer
    Dim CopyHeaderData As String
    
    UpdateGrpRecId
   
    OwnerClientNameRptVar = ""
    ContractDescrpRptVar = ""
    AddressRptVar = ""
    ConstrMeetingCallinRptVar = ""
    ConstrMeetingAccessCodeRptVar = ""
    ConstrMtgLocationHeaderRptVar = ""
    ContractIdCoverRptVar = ""
    ContractDescrpHdrRptVar = ""
    AddressHdrRptVar = ""
   
    Set dbs = CurrentDb
    
    STRUSERID = GetNetUserName()

    If IsNull(Me![MtgNoteDaysInput]) Then
        MtgNoteDays = 20
        varReportNotesActionHistoryDays = 20 '09-11-2017
    Else
        MtgNoteDays = Me![MtgNoteDaysInput].Value
        varReportNotesActionHistoryDays = Me![MtgNoteDaysInput] '09-11-2017
    End If

    StrSql = "SELECT [01_Wkg_ConstrContrGroupXrefTbl].ContractId AS ContractIDFilter, [01_Wkg_ConstrContrGroupXrefTbl].ContrGrpRecId, [01_Wkg_ConstrContrGroupXrefTbl_1].ContractId, "
    StrSql = StrSql & "[01_Wkg_ConstrContrMainDataTbl].ContractDescrp FROM 01_Wkg_ConstrContrGroupXrefTbl LEFT JOIN (01_Wkg_ConstrContrGroupXrefTbl AS 01_Wkg_ConstrContrGroupXrefTbl_1 "
    StrSql = StrSql & "LEFT JOIN 01_Wkg_ConstrContrMainDataTbl ON [01_Wkg_ConstrContrGroupXrefTbl_1].ContractId = [01_Wkg_ConstrContrMainDataTbl].ContractId) ON "
    StrSql = StrSql & "[01_Wkg_ConstrContrGroupXrefTbl].ContrGrpRecId = [01_Wkg_ConstrContrGroupXrefTbl_1].ContrGrpRecId WHERE [01_Wkg_ConstrContrGroupXrefTbl].ContractId = "
    StrSql = StrSql & """" & Forms![0_masterdatafrm]![DefaultContrId] & """"
    StrSql = StrSql & " ORDER BY [01_Wkg_ConstrContrGroupXrefTbl_1].ContractId;"

    Set Rstx = dbs.OpenRecordset(StrSql)
    
    If Not Rstx.EOF Then
        Rstx.MoveFirst
        
        While Not Rstx.EOF
            If Len(CompositeFilter) = 0 Then
                CompositeFilter = "[ContractId] = " & """" & Rstx![ContractId] & """"
            Else
                CompositeFilter = CompositeFilter & " or " & "[ContractId] = " & """" & Rstx![ContractId] & """"
            End If
        
            StrSql = "SELECT DISTINCT [80_ConstrMtgAgendaWkgTbl].ContractId, [80_ConstrMtgAgendaWkgTbl].MeetingNumber, [80_ConstrMtgAgendaWkgTbl].MeetingDate, [80_ConstrMtgListWkgTbl].MeetingTime, "
            StrSql = StrSql & "[01_Wkg_ConstrContrMainDataTbl].OwnerClientName, [01_Wkg_ConstrContrMainDataTbl].ContractDescrp, [01_Wkg_ConstrContrMainDataTbl].BusinessAddressStreet, "
            StrSql = StrSql & "[01_Wkg_ConstrContrMainDataTbl].BusinessAddressCity, [01_Wkg_ConstrContrMainDataTbl].BusinessAddressState, [01_Wkg_ConstrContrMainDataTbl].BusinessAddressPostalCode, "
            StrSql = StrSql & "[80_ConstrMtgListWkgTbl].[ConstrMeetingCall-in], [80_ConstrMtgListWkgTbl].ConstrMeetingAccessCode, [80_ConstrMtgListWkgTbl].ConstrMtgLocation, [01_Wkg_ConstrContrGroupTbl].ContrGrpDescription "
            StrSql = StrSql & "FROM ((01_Wkg_ConstrContrMainDataTbl INNER JOIN 80_ConstrMtgAgendaWkgTbl ON [01_Wkg_ConstrContrMainDataTbl].ContractId = [80_ConstrMtgAgendaWkgTbl].ContractId) INNER JOIN 80_ConstrMtgListWkgTbl "
            StrSql = StrSql & "ON ([80_ConstrMtgAgendaWkgTbl].ContractId = [80_ConstrMtgListWkgTbl].ContractId) AND ([80_ConstrMtgAgendaWkgTbl].MeetingNumber = [80_ConstrMtgListWkgTbl].MeetingNumber)) LEFT JOIN "
            StrSql = StrSql & "(01_Wkg_ConstrContrGroupXrefTbl LEFT JOIN 01_Wkg_ConstrContrGroupTbl ON [01_Wkg_ConstrContrGroupXrefTbl].ContrGrpRecId = [01_Wkg_ConstrContrGroupTbl].ContrGrpRecId) "
            StrSql = StrSql & "ON [01_Wkg_ConstrContrMainDataTbl].ContractId = [01_Wkg_ConstrContrGroupXrefTbl].ContractId "
            StrSql = StrSql & "WHERE [80_ConstrMtgAgendaWkgTbl].ContractId = "
            StrSql = StrSql & """" & Rstx![ContractId] & """"
            StrSql = StrSql & " And [80_ConstrMtgAgendaWkgTbl].MeetingNumber = "
            StrSql = StrSql & Me![MeetingNumber]
            StrSql = StrSql & " ORDER BY [80_ConstrMtgAgendaWkgTbl].ContractId;"

            Set Rstz = dbs.OpenRecordset(StrSql)
                If Not Rstz.EOF Then
                    Rstz.MoveFirst
            
                    If Len(OwnerClientNameRptVar) = 0 Then OwnerClientNameRptVar = Nz(Rstz![OwnerClientName])
                    If Len(ContractDescrpRptVar) = 0 Then ContractDescrpRptVar = Rstz![ContrGrpDescription]
                    If Len(AddressRptVar) = 0 Then AddressRptVar = Rstz![BusinessAddressStreet] & " " & Rstz![BusinessAddressCity] & " " & Rstz![BusinessAddressState] & " " & Rstz![BusinessAddressPostalCode]
                    If Len(ConstrMeetingCallinRptVar) = 0 Then ConstrMeetingCallinRptVar = Nz(Rstz![ConstrMeetingCall-in])
                    If Len(ConstrMeetingAccessCodeRptVar) = 0 Then ConstrMeetingAccessCodeRptVar = Nz(Rstz![ConstrMeetingAccessCode])
                    If Len(ConstrMtgLocationHeaderRptVar) = 0 Then ConstrMtgLocationHeaderRptVar = Rstz![ConstrMtgLocation]
                    If Len(ContractDescrpHdrRptVar) = 0 Then ContractDescrpHdrRptVar = Rstz![ContrGrpDescription]
                    If Len(AddressHdrRptVar) = 0 Then AddressHdrRptVar = Rstz![BusinessAddressStreet] & " " & Rstz![BusinessAddressCity] & " " & Rstz![BusinessAddressState] & " " & Rstz![BusinessAddressPostalCode]
                
                    If Len(ContractIdCoverRptVar) = 0 Then
                        ContractIdCoverRptVar = Rstx![ContractId]
                    Else
                        ContractIdCoverRptVar = ContractIdCoverRptVar & " & " & Rstx![ContractId]
                    End If
                End If

            Rstx.MoveNext
        Wend
        
        WkgWklyMtgRptFilter = "(" & CompositeFilter & ") and [MeetingNumber] = " & Me![MeetingNumber] '& " and [MeetingDate] = " & Me![MeetingDate] '09-20-2017
    Else
            StrSql = "SELECT DISTINCT [80_ConstrMtgAgendaWkgTbl].ContractId, [80_ConstrMtgAgendaWkgTbl].MeetingNumber, [80_ConstrMtgAgendaWkgTbl].MeetingDate, [80_ConstrMtgListWkgTbl].MeetingTime, "
            StrSql = StrSql & "[01_Wkg_ConstrContrMainDataTbl].OwnerClientName, [01_Wkg_ConstrContrMainDataTbl].ContractDescrp, [01_Wkg_ConstrContrMainDataTbl].BusinessAddressStreet, "
            StrSql = StrSql & "[01_Wkg_ConstrContrMainDataTbl].BusinessAddressCity, [01_Wkg_ConstrContrMainDataTbl].BusinessAddressState, [01_Wkg_ConstrContrMainDataTbl].BusinessAddressPostalCode, "
            StrSql = StrSql & "[80_ConstrMtgListWkgTbl].[ConstrMeetingCall-in], [80_ConstrMtgListWkgTbl].ConstrMeetingAccessCode, [80_ConstrMtgListWkgTbl].ConstrMtgLocation, [01_Wkg_ConstrContrGroupTbl].ContrGrpDescription "
            StrSql = StrSql & "FROM ((01_Wkg_ConstrContrMainDataTbl INNER JOIN 80_ConstrMtgAgendaWkgTbl ON [01_Wkg_ConstrContrMainDataTbl].ContractId = [80_ConstrMtgAgendaWkgTbl].ContractId) INNER JOIN 80_ConstrMtgListWkgTbl "
            StrSql = StrSql & "ON ([80_ConstrMtgAgendaWkgTbl].ContractId = [80_ConstrMtgListWkgTbl].ContractId) AND ([80_ConstrMtgAgendaWkgTbl].MeetingNumber = [80_ConstrMtgListWkgTbl].MeetingNumber)) LEFT JOIN "
            StrSql = StrSql & "(01_Wkg_ConstrContrGroupXrefTbl LEFT JOIN 01_Wkg_ConstrContrGroupTbl ON [01_Wkg_ConstrContrGroupXrefTbl].ContrGrpRecId = [01_Wkg_ConstrContrGroupTbl].ContrGrpRecId) "
            StrSql = StrSql & "ON [01_Wkg_ConstrContrMainDataTbl].ContractId = [01_Wkg_ConstrContrGroupXrefTbl].ContractId "
            StrSql = StrSql & "WHERE [80_ConstrMtgAgendaWkgTbl].ContractId = "
            StrSql = StrSql & """" & Forms![0_masterdatafrm]![DefaultContrId] & """"
            StrSql = StrSql & " And [80_ConstrMtgAgendaWkgTbl].MeetingNumber = "
            StrSql = StrSql & Me![MeetingNumber]
            StrSql = StrSql & " ORDER BY [80_ConstrMtgAgendaWkgTbl].ContractId;"

            Set Rstz = dbs.OpenRecordset(StrSql)
                If Not Rstz.EOF Then
                    Rstz.MoveFirst
            
                    If Len(OwnerClientNameRptVar) = 0 Then OwnerClientNameRptVar = Rstz![OwnerClientName]
                    If Len(ContractDescrpRptVar) = 0 Then ContractDescrpRptVar = Rstz![ContractDescrp]
                    If Len(AddressRptVar) = 0 Then AddressRptVar = Rstz![BusinessAddressStreet] & " " & Rstz![BusinessAddressCity] & " " & Rstz![BusinessAddressState] & " " & Rstz![BusinessAddressPostalCode]
'                    If Len(ConstrMeetingCallinRptVar) = 0 Then ConstrMeetingCallinRptVar = Nz(Rstz![ConstrMeetingCall-in])
'                    If Len(ConstrMeetingAccessCodeRptVar) = 0 Then ConstrMeetingAccessCodeRptVar = Nz(Rstz![ConstrMeetingAccessCode])
'                    If Len(ConstrMtgLocationHeaderRptVar) = 0 Then ConstrMtgLocationHeaderRptVar = Rstz![ConstrMtgLocation]
                    If Len(ContractDescrpHdrRptVar) = 0 Then ContractDescrpHdrRptVar = Rstz![ContractDescrp]
                    If Len(AddressHdrRptVar) = 0 Then AddressHdrRptVar = Rstz![BusinessAddressStreet] & " " & Rstz![BusinessAddressCity] & " " & Rstz![BusinessAddressState] & " " & Rstz![BusinessAddressPostalCode]
                    If Len(ContractIdCoverRptVar) = 0 Then ContractIdCoverRptVar = Forms![0_masterdatafrm]![DefaultContrId]
                End If
        
        
        WkgWklyMtgRptFilter = "[ContractId] = " & """" & Forms![0_masterdatafrm]![DefaultContrId] & """" & " and [MeetingNumber] = " & Me![MeetingNumber] '& " and [MeetingDate] = " & Me![MeetingDate] '09-20-2017
    End If

'2019-01-12----------------------------------------
SubReportFilter

MsgBox WkgWklyMtgRptFilter & vbNewLine & Right(StrSql, 150)
'2019-01-12------------------------------------------
    DoCmd.OpenReport "81_ConstrMtgNotesWkgRpt", acPreview

End Sub

Open in new window

SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Finally got it sorted out - thanks for the help

I had the subreport running an embedded query rather than a named query as a data source

Saved the embedded query and added steps to reconfigure it and it runs fine

The attached word document describes it for future reference

Thanks again for your patient assistance
PMDataBase---Edit-Subreport-Data-So.docx
You are welcome!
Thanks for the feedback.