[draytond]

I have several related tables that store information about projects. The primary table is tblProjects.

The end goal is to have all of the individual records in tblProjects displayed in a subform that I can then filter based on criteria. For example, I have drop-down that lets the user select different types of projects. For the purpose of keeping this simple, let's assume the only two kinds of projects are "health clinic" projects and "community center" projects, which each provide those buildings to their communities. So I want to be able to filter and show only the "health center" projects, or only the "community center" projects.

The problem is that there are several projects that fit into both categories, and it's recorded in a separate table. The columns in this separate table include the primary key of the project, and the type of category (so each project could have potentially infinite categories.

Now, is there any way to initially show just one row per project, but then filter down the projects to show only the "health clinic" projects, or only the "community center" projects using filters based on the user's input? The issue I'm having now is that projects with multiple categories are showing up multiple times in the initial list: once to show the record with the "community center" category and once to show the "health clinic" category. How do I get rid of the double entry without losing the ability to filter on either of the categories?

[OBP]

Why not have a main form to filter the Projects and a subform to filter the Project Types?

There is an alternative that I posted that uses table pre-filtering VBA code that will probably work.

[draytond]

Ok, well in reality there are like 8 tables that are being brought into the mix, not just one. They're all causing the problem above, so I'm hoping that however we solve that issue, it will fix all the issues.

Right now, I'm actually using VBA to take care of this (code that you wrote, actually) and the way it works is by finding all the project IDs that fit the criteria, then setting the filter to something like (projectID=4 OR projectID=12 OR projectID=25). That's working well, but the problem is that when there are too many projects that meet the criteria, the string gets too long for the filter and there's an error. That problem isn't happening if I set the filter to be the WHERE clause of the SQL statement I'm trying to craft above. But I'll defer to your advise.

[OBP]

I don't know what to advise as you are already using VBA.
you could do some pre-filtering using filtered queries.

[draytond]

In an old post, you recommended the following:

"You can use the QueryDef function to replace the definition of a Query using the mainform Filtering without changing the query name.
You can then use that query as the record source of a simple select query which is the record source of the subform.
The downside is the database may grow a bit when the query def is changed."

Do you still think this is a good solution? If so, could you give me some more info on it? I never followed through with it because it seemed so complex I wasn't sure where to start.

[OBP]

It is even simpler than that for a form, you can just create the SQL and then set the record source to the SQL, you don't actually need the query def which I was using for a report.
I assume you can also do it for a report.

[draytond]

Ok, so I guess that brings us back to how to create this query to get that SQL.

[OBP]

How many tables & fields do you have to filter by?
Can you show me the Search Form?

[draytond]

Here's the actual query (in design view) and the search form.

[OBP]

Does the query provide all the records that you need?

[draytond]

It did until I added the "update visible on website" check, which is in the Project Updates table.

Number of projects in the database: 260
Number of projects records before "visible on website": 546 (with many projects coming up multiple times)
Number of projects after visible on website added: 169

[OBP]

That suggests that you would need different join for that table, to show all records form the main table & only those matching in the Project Updates table, but if you do that you have to do the same for all of the others as well.
Try it and see if it returns 546 again.

Looking at your form I wouldn't have thought it had any more fields on it than 2 other databases using the form filtering method.

[draytond]

Ok, I made a separate query, then called that instead of the Updates table, so now I'm back to 546.

[OBP]

So do you currently have any VBA SQL?

[draytond]

Here's the code for the Filter button, which is pressed after the criteria have been chosen. Notice that a large chunk isn't being used, since we're no longer filtering by ID. We're now using strSQLEHERE in the form's filter instead of using strWhere.

Private Sub cmdFilter_Click()
Dim er As Integer, A As Integer, whereLen As Long, fromLen As Long, selectLen As Long, RS As Object, SQL As String, count As Integer, strWhere As String, strSQLWHERE As String, strSQLFROM As String, strSQLSELECT As String
Const conJetDate = "\#mm\/dd\/yyyy\#"  'The format expected for dates in a JET query string.

'STATUS
    If Not IsNull(Me.cboStatus) Then
        strSQLWHERE = strSQLWHERE & "([fkStatusID] = " & Me.cboStatus & ") AND "
    End If

'APPROVAL ***YEAR***
    If Not IsNull(Me.dateApproval) Then
        strSQLWHERE = strSQLWHERE & "(DatePart('yyyy',[BoardApprovalDate]) = " & Me.dateApproval & ") AND "
    End If

'SPECIFIC APPROVAL DATE
    If Not IsNull(Me.expirationSpecificDate) Then
        strSQLWHERE = strSQLWHERE & "([BoardApprovalDate] = " & Format(Me.expirationSpecificDate, conJetDate) & ") AND "
    End If

'APPROVAL DATE RANGE
    If Not IsNull(Me.dateApproval1) Then
        strSQLWHERE = strSQLWHERE & "([BoardApprovalDate] >= " & Format(Me.dateApproval1, conJetDate) & ") AND "
    End If
    
    If Not IsNull(Me.dateApproval2) Then
        strSQLWHERE = strSQLWHERE & "([BoardApprovalDate] <= " & Format(Me.dateApproval2, conJetDate) & ") AND "
    End If
    
'COMPLETION DATE RANGE
    If Not IsNull(Me.completed1) Then
        strSQLWHERE = strSQLWHERE & "([DateFinalReportCompleted] >= " & Format(Me.completed1, conJetDate) & ") AND "
    End If
    
    If Not IsNull(Me.completed2) Then
        strSQLWHERE = strSQLWHERE & "([DateFinalReportCompleted] <= " & Format(Me.completed2, conJetDate) & ") AND "
    End If
    
'EXPIRATION ***YEAR***
    If Not IsNull(Me.dateExpiration) Then
        strSQLWHERE = strSQLWHERE & "(DatePart('yyyy',[ExpirationDate]) = " & Me.dateExpiration & ") AND "
    End If
    
'IN PERPETUITY RADIO
    If (Me.radioPerpetuity < 3) Then
        If (Me.radioPerpetuity = 1) Then    ' YES, in perpetuity
            'strSQLWHERE = strSQLWHERE & "(IsNull([ExpirationDate]) = True) AND "                  'this works, but it would also return projects with no conservation element
            strSQLWHERE = strSQLWHERE & "([perpetuity] = -1) AND "    'the perpetuity box has to be checked
        End If
        If (Me.radioPerpetuity = 2) Then    ' NO, not in perpetuity
            strSQLWHERE = strSQLWHERE & "(([ExpirationDate] <> Null) OR ([perpetuity] = 0)) AND "   'there has to be an expiration date OR the perpetuity check box has to be left unchecked
        End If
    End If
    
'NO EXPIRATION RADIO
If (Me.radionoexpiration < 3) Then
    If (Me.radionoexpiration = 1) Then    ' YES, no expiration date
        strSQLWHERE = strSQLWHERE & "([nosetduration] = -1) AND "
    End If
    If (Me.radionoexpiration = 2) Then    ' NO, there is an expiration date
        strSQLWHERE = strSQLWHERE & "([nosetduration] = 0) AND "
    End If
End If
    
'EXPIRATION DATE RANGE
    If Not IsNull(Me.dateExpiration1) Then
        strSQLWHERE = strSQLWHERE & "([ExpirationDate] >= " & Format(Me.dateExpiration1, conJetDate) & ") AND "
    End If
    
    If Not IsNull(Me.dateExpiration2) Then
        strSQLWHERE = strSQLWHERE & "([ExpirationDate] <= " & Format(Me.dateExpiration2, conJetDate) & ") AND "
    End If

'NEW TERRESTRIAL ACRES RANGE
        If Not IsNull(Me.newTerrestrial1) Then
            strSQLWHERE = strSQLWHERE & "([NewTerrestrialAcres] >= " & Me.newTerrestrial1 & ") AND "
        End If
        
        If Not IsNull(Me.newTerrestrial2) Then
            strSQLWHERE = strSQLWHERE & "([NewTerrestrialAcres] <= " & Me.newTerrestrial2 & ") AND "
        End If

'EXISTING TERRESTRIAL ACRES RANGE
        If Not IsNull(Me.existingTerrestrial1) Then
            strSQLWHERE = strSQLWHERE & "([ExistingTerrestrialAcres] >= " & Me.existingTerrestrial1 & ") AND "
        End If
        
        If Not IsNull(Me.existingTerrestrial2) Then
            strSQLWHERE = strSQLWHERE & "([ExistingTerrestrialAcres] <= " & Me.existingTerrestrial2 & ") AND "
        End If

'NEW MARINE ACRES RANGE
        If Not IsNull(Me.newMarine1) Then
            strSQLWHERE = strSQLWHERE & "([NewMarineAcres] >= " & Me.newMarine1 & ") AND "
        End If
        
        If Not IsNull(Me.newMarine2) Then
            strSQLWHERE = strSQLWHERE & "([NewMarineAcres] <= " & Me.newMarine2 & ") AND "
        End If

'EXISTING MARINE ACRES RANGE
        If Not IsNull(Me.existingMarine1) Then
            strSQLWHERE = strSQLWHERE & "([ExistingMarineAcres] >= " & Me.existingMarine1 & ") AND "
        End If
        
        If Not IsNull(Me.existingMarine2) Then
            strSQLWHERE = strSQLWHERE & "([ExistingMarineAcres] <= " & Me.existingMarine2 & ") AND "
        End If
        
'REGION COMBO
        If Not IsNull(Me.cboRegion) Then
            strSQLWHERE = strSQLWHERE & "([Region] = '" & Me.cboRegion & "') AND "
        End If

'COUNRTY COMBO
        If Not IsNull(Me.cboCountry) Then
            strSQLWHERE = strSQLWHERE & "([CountryName] = '" & Me.cboCountry & "') AND "
        End If
        
'ISLAND COMBO
        If Not IsNull(Me.cboIsland) Then
            strSQLWHERE = strSQLWHERE & "([IslandName] = '" & Me.cboIsland & "') AND "
        End If

'COMMUNITY/AREA COMBO
        'If Not IsNull(Me.cboCommunity) Then
            'strSQLWHERE = strSQLWHERE & "([CommunityOrArea] = '" & Me.cboCommunity & "') AND "
        'End If
        
'BENEFIT TOP CATEGORY COMBO
        If Not IsNull(Me.cboTop) Then
            strSQLWHERE = strSQLWHERE & "([TopCategory] = " & Me.cboTop & ") AND "
        End If
    
'BENEFIT SUB CATEGORY COMBO
        If Not IsNull(Me.cboSub) Then
            strSQLWHERE = strSQLWHERE & "([SubCategory] = '" & Me.cboSub & "') AND "   '[tblBenefitRecords.SubCategory]
        End If
        
'CONSERVATION TOP CATEGORY COMBO
        If Not IsNull(Me.cboConTop) Then
            strSQLWHERE = strSQLWHERE & "([Top Conservation Category] = " & Me.cboConTop & ") AND "
        End If
    
'CONSERVATION SUB CATEGORY COMBO
        If Not IsNull(Me.cboConSub) Then
            strSQLWHERE = strSQLWHERE & "([Sub Conservation Category] = '" & Me.cboConSub & "') AND "
        End If
        
'UNRESTRICTED FUNDS RANGE
        If Not IsNull(Me.Text132) Then
            strSQLWHERE = strSQLWHERE & "([UpdatedUnrestrictedFunds] >= " & Me.Text132 & ") AND "
        End If
        
        If Not IsNull(Me.Text131) Then
            strSQLWHERE = strSQLWHERE & "([UpdatedUnrestrictedFunds] <= " & Me.Text131 & ") AND "
        End If

'FUNDER COMBO
        If Not IsNull(Me.cboFunder) Then
            strSQLWHERE = strSQLWHERE & "([_fkFunderID] = " & Me.cboFunder & ") AND "
        End If
    
'UNPUBLISHED UPDATES RADIO
    If (Me.radioUnpublished < 3) Then
        If (Me.radioUnpublished = 1) Then    ' YES, has unpublished updates
            strSQLWHERE = strSQLWHERE & "([UpdateVisibleOnWebsite] = '0') AND "
        End If
        If (Me.radioUnpublished = 2) Then    ' NO, does not have unpublished updates
            strSQLWHERE = strSQLWHERE & "([UpdateVisibleOnWebsite] = '-1') AND "
        End If
    End If
    
'PAYMENT STATUS
    If (Me.PaymentStatus < 3) Then
        If (Me.PaymentStatus = 1) Then    ' project is paid in full
            strSQLWHERE = strSQLWHERE & "([remainingtopay] = 0) AND "
        End If
        If (Me.PaymentStatus = 2) Then    ' not paid in full
            strSQLWHERE = strSQLWHERE & "([remainingtopay] > 0) AND "
        End If
    End If
    
'PROJECT VISIBLE ON WEBSITE RADIO radioProjectOnWebsite
    If (Me.radioProjectOnWebsite < 4) Then
        If (Me.radioProjectOnWebsite = 1) Then    ' YES, project is visible on website
            strSQLWHERE = strSQLWHERE & "([VisibleOnWebsite] = 1) AND "
        End If
        If (Me.radioProjectOnWebsite = 2) Then    ' Not visible YET
            strSQLWHERE = strSQLWHERE & "([VisibleOnWebsite] = 2) AND "
        End If
        If (Me.radioProjectOnWebsite = 3) Then    ' Keep project off website
            strSQLWHERE = strSQLWHERE & "([VisibleOnWebsite] = 3) AND "
        End If
    End If

'SET THE FILTER

    whereLen = Len(strSQLWHERE)
    If whereLen <= 0 Then 'Nah there was nothing in the string.
        MsgBox "No criteria", vbInformation, "Nothing to do."
    Else
    'Yep there is something there, so remove the " AND " at the end of the WHERE, and remove
    'the trailing ", " from the FROM and SELECT strings

        whereLen = Len(strSQLWHERE) - 5
        strSQLWHERE = Left(strSQLWHERE, whereLen)
            
        strSQLSELECT = "SELECT DISTINCT tblProjects.[__pkProjectID], tblRestrectedFunds.*, tblProjectUpdates.*, tblProjectsUnRestrictedFundsQuery.*, tblProjects.[__pkProjectID] AS Project, tblConservationTypeRecord.*, tblProjects.fkStatusID, tblProjects.Region, tblProjects.BoardApprovalDate, tblProjects.Country, tblProjects.Island, tblProjects.Provence, tblProjects.District, tblProjects.CommunityOrArea, tblProjects.SummaryDescription, tblProjects.Description, tblProjects.InternalDescription, tblProjects.ProtectedAreaDescription, tblProjects.ExpirationDate, " & _
                       "tblProjects.ProjectStatus, tblProjects.LocalCurrency, tblProjects.[RequestedGrantAmount(inLocalCurrency)], tblProjects.[GrantAmountAsOfApprovalDate(USD)], tblProjects.[Actual Grant Amount(USD)], tblProjects.PaymentStatus, tblProjects.NewTerrestrialAcres, tblProjects.ExistingTerrestrialAcres, tblProjects.NewMarineAcres, tblProjects.ExistingMarineAcres, tblProjects.FiscalAdmin, tblProjects.DateFiscalAdminReceived, tblProjects.Timeline, tblProjects.DateTimelineReceived, tblProjects.Budget, " & _
                       "tblProjects.DateBudgetReceived, tblProjects.[DateFinalReportCompleted], tblProjects.Map, tblProjects.DateMapReceived, tblProjects.SignedCovenanat, tblProjects.DateCovenantReceived, tblProjects.FFGfundAuth, tblProjects.[1stPaymentInLocalCurrency], tblProjects.[1stPaymentCurrencyConversionDate], tblProjects.[1stPaymentConversionRate], tblProjects.[1stPaymentActual$Paid], tblProjects.[1stPaymentPaidOnDate], tblProjects.[1stPaymentSignedGrantAgreement], tblProjects.[1stPaymentAgreementDate], " & _
                       "tblProjects.[1stPaymentCheckSDNList], tblProjects.[1stpaymentSDNCheckDate], tblProjects.[1stPaymentWiringInstructions], tblProjects.[1stpaymentWiringInstructionsDate], tblProjects.[1stPayOther1Description], tblProjects.[1stPayOther1DateReceived], tblProjects.[1stPayOther1Status], tblProjects.[1stPayOther2Description], tblProjects.[1stPayOther2DateReceived], tblProjects.[1stPayOther2Status], tblProjects.DateFFGauthReceived, tblProjects.FinalReportDueDate, tblProjects.DateFinalReportNarrativeReceived, " & _
                       "tblProjects.FinalReportNarrative, tblProjects.[nosetduration], tblProjects.DateFinalReportCompleted, tblProjects.FinalReportPhotos, tblProjects.DateFinalReportPhotosReceived, tblProjects.FinalReportAccounting, tblProjects.DateFinalAccountingReceived, tblProjects.FinalReportOther1Description, tblProjects.FinalReportOther1DateReceived, tblProjects.FinalReportOther1Received, tblProjects.FinalReportOther2Description, tblProjects.FinalReportOther2DateReceived, tblProjects.FinalReportOther2Received, tblProjects.[Proposed Purchase of Land Amount], tblProjects.[Actual Purchase of Land Amount], tblProjects.[Proposed Construction Materials Amount], tblProjects.[Actual Construction Materials Amount], tblProjects.[Proposed Transportation & Freight Amount], " & _
                       "tblProjects.[Actual Transportation & Freight Amount], tblProjects.[perpetuity], tblProjects.[Proposed Computers & Electronics Amount], tblProjects.[Actual Computers & Electronics Amount], tblProjects.[Proposed Skilled Labor & Professional Services Amount], tblProjects.[Actual Skilled Labor & Professional Services Amount], tblProjects.[Proposed Facility & Program Expenses Amount], tblProjects.[Actual Facility & Program Expenses Amount], tblProjects.[Proposed Conservation Costs Amount], tblProjects.[Actual Conservation Costs Amount], tblProjects.[Proposed Replanting & Rehabilitation Amount], tblProjects.[Actual Replanting & Rehabilitation Amount], tblProjects.[Proposed Meeting and Planning Expenses Amount], tblProjects.[Actual Meeting and Planning Expenses Amount], " & _
                       "tblProjects.[Proposed Administrative Fees Amount], tblProjects.[Actual Administrative Fees Amount], tblProjects.[Proposed Miscellaneous Expenses/Contingency Amount], tblProjects.[Actual Miscellaneous Expenses/Contingency Amount], tblProjects.ProposedOther1, tblProjects.ActualOther1, tblProjects.OtherBudget1Description, tblProjects.ProposedOther2, tblProjects.ActualOther2, tblProjects.OtherBudget2Description, tblProjects.Website, tblProjects.VisibleOnWebsite, tblProjects.BudgetExchangeRate, tblProjects.[On Site Project Leader], tblProjectCountriesAndIslands.[ProjectID], tblProjectCountriesAndIslands.[CountryName], tblProjectCountriesAndIslands.[IslandName], tblProjectCountriesAndIslands.[RegionName], tblProjectCountriesAndIslands.[ID], tblProjectCountriesAndIslands.[ExcludeCountry], tblProjectCountriesAndIslands.[ExcludeIsland]"
        
        strSQLFROM = "(((((tblProjects LEFT JOIN tblBenefitRecords ON tblProjects.[__pkProjectID] = tblBenefitRecords.[_fkProjectID]) LEFT JOIN tblConservationTypeRecord ON tblProjects.[__pkProjectID] = tblConservationTypeRecord.[_fkProjectID]) LEFT JOIN tblProjectUpdates ON tblProjects.[__pkProjectID] = tblProjectUpdates.[_fkProjectID]) LEFT JOIN tblProjectsUnRestrictedFundsQuery ON tblProjects.[__pkProjectID] = tblProjectsUnRestrictedFundsQuery.[__pkProjectID]) LEFT JOIN tblRestrectedFunds ON tblProjects.[__pkProjectID] = tblRestrectedFunds.[_fkProjectID]) LEFT JOIN tblProjectCountriesAndIslands ON tblProjects.[__pkProjectID] = tblProjectCountriesAndIslands.[ProjectID]"
               
        SQL = strSQLSELECT & " FROM " & strSQLFROM & " WHERE " & strSQLWHERE & ";"
               
        'now use that SQL statement to select only the IDs you want in the subform
        Set RS = CurrentDb.OpenRecordset(SQL)
        If RS.RecordCount = 0 Then
            'Dim noResults As String
            'noResults = "None"
            Me![frm_project_search_results].Form.Filter = "Country = 'Nowhereland'"
            Me.[frm_project_search_results].Form.FilterOn = True
            MsgBox ("No projects meet your requirements.")
            RS.Close
            Set RS = Nothing
            Exit Sub
        End If
        
        RS.MoveLast
        RS.MoveFirst
        
        If RS.RecordCount > 0 Then
            'MsgBox rs.RecordCount
            'For count = 1 To rs.RecordCount
                'strWhere = strWhere & "([ProjectID] = " & rs![Project] & ") Or"
                'rs.MoveNext
                'Next count
            For count = 1 To RS.RecordCount
             X = InStr(strWhere, RS![Project])
                If X = 0 Then
                    strWhere = strWhere & "([p]=" & RS![Project] & ")Or"
                End If
                RS.MoveNext
                Next count
        End If

        RS.Close
        Set RS = Nothing

        strWhere = Left(strWhere, Len(strWhere) - 2) ' chop off the last "Or"
        
        'was using strWhere, but that resulted in "too long" error where there were too many projects that matched the criteria since the string got too long for the filter.  So switching to strSQLWHERE, which is more complex...
           
        'Me![frm_project_search_results].Form.Filter = strWhere
        Me![frm_project_search_results].Form.Filter = strSQLWHERE
        Me.[frm_project_search_results].Form.FilterOn = True
    End If
    
End Sub