Query Menu - Filter Results, but include all Records - In Select?

[misscrf]

I think I need to incorporate an in Select statement to the sql that I have built in some vba code. I have been trying to set it up, but I am missing some syntax or something.

What I have is a form with many list boxes and fields, to allow for a mirad of reports. Any filters can be chosen, and and combination of filters can be chosen. One listbox contains the fields to display on the report. Those will affect the grouping.

Once the user selects the filters and fields, they click to run the summary. The subform control becomes visible and its source becomes the built query.

This will show projects and clients involved in projects. Many clients can be in many projects.

Right now, if a user chooses 3 clients, then only the projects that have those 3 clients will show. Also, only those 3 clients will show, even if there are 5 clients in a shown project.

This works for some needs, but the users now need a report, that when they choose 1 or more clients to filter, they still need to see the other clients in that project. So instead of the clients chosen in the listbox to = the query field, I need them to be "in" the query.

This is the code that I have, which does the former:

Private Sub cmdSummary_Click()
 
 Dim Mysql As String
 Dim strCriteria As String
 Dim strFields As String
 Dim strQuery As String
 Dim lbo As ListBox
 Dim itm
 Dim i As Long
 strQuery = "qryProjectActiveFields"
 Set lbo = Me.lstFields
 If Me.lstFields.ItemsSelected.Count = 0 Then
 'If Me.lstFields.ListIndex = -1 Then
 For i = 0 To Me.lstFields.ListCount - 1
 Me.lstFields.Selected(i) = True
 Next
 For Each itm In lbo.ItemsSelected
 strFields = strFields & "[" & lbo.ItemData(itm) & "], "
 Next
 strFields = Left(strFields, Len(strFields) - 2)
 Else
 For Each itm In lbo.ItemsSelected
 strFields = strFields & "[" & lbo.ItemData(itm) & "], "
 Next
 strFields = Left(strFields, Len(strFields) - 2)
 End If
 Const conJetDate = "\#mm\/dd\/yyyy\#"   'The format expected for dates in a JET query string.
 strCriteria = "1=1 "
 strCriteria = strCriteria & _
   BuildIn(Me.LstProjectStatus, "[Project Status]", "'")
 strCriteria = strCriteria & _
   BuildIn(Me.lstJurisdiction, "Jurisdiction", "'")
 strCriteria = strCriteria & _
   BuildIn(Me.lstVenue, "Venue", "'")
 strCriteria = strCriteria & _
 [COLOR=red] BuildIn(Me.lstClient, "[Client/Customer]", "'")[/color]
 If Len(Me.dtSignedFrom & vbNullString) = 0 Then
 strCriteria = strCriteria _
 & " AND 1=1"
 Else
 strCriteria = strCriteria & _
 " AND ([Client/Customer Signed Date]) >= " & Format(Me.dtSignedFrom, conJetDate)
 End If
 If Len(Me.dtSignedTo & vbNullString) = 0 Then
 strCriteria = strCriteria _
 & " AND 1=1"
 Else
 strCriteria = strCriteria & _
 " AND ([Client/Customer Signed Date]) <= " & Format(Me.dtSignedTo, conJetDate)
 End If
 If Len(Me.dtContractFrom & vbNullString) = 0 Then
 strCriteria = strCriteria _
 & " AND 1=1"
 Else
 strCriteria = strCriteria & _
 " AND ([Client/Customer Contract Date]) >= " & Format(Me.dtContractFrom, conJetDate)
  End If
 If Len(Me.dtContractTo & vbNullString) = 0 Then
 strCriteria = strCriteria _
 & " AND 1=1"
 Else
 strCriteria = strCriteria & _
 " AND ([Client/Customer Contract Date]) <= " & Format(Me.dtContractTo, conJetDate)
 End If
 If Len(Me.dtVenueFrom & vbNullString) = 0 Then
 strCriteria = strCriteria _
 & " AND 1=1"
 Else
 strCriteria = strCriteria & _
 " AND ([Venue Effective Date]) >= " & Format(Me.dtVenueFrom, conJetDate)
 End If
 If Len(Me.dtVenueTo & vbNullString) = 0 Then
 strCriteria = strCriteria _
 & " AND 1=1"
 Else
 strCriteria = strCriteria & _
 " AND ([Venue Effective Date]) <= " & Format(Me.dtVenueTo, conJetDate)
 End If
 If Len(Me.dtProjectFrom & vbNullString) = 0 Then
 strCriteria = strCriteria _
 & " AND 1=1"
 Else
 strCriteria = strCriteria & _
 " AND ([Project Signed Date]) >= " & Format(Me.dtProjectFrom, conJetDate)
 End If
 If Len(Me.dtProjectTo & vbNullString) = 0 Then
 strCriteria = strCriteria _
 & " AND 1=1"
 Else
 strCriteria = strCriteria & _
 " AND ([Project Signed Date]) <= " & Format(Me.dtProjectTo, conJetDate)
 End If
 Mysql = "SELECT  " & strFields & " FROM  qryProjectActive inner JOIN qrydtCurrentVenue ON (qrydtCurrentVenue.PKProjectID = qryProjectActive.[Project ID]) AND (qrydtCurrentVenue.MaxOfdtEffectiveDate = qryProjectActive.[Venue Effective Date]) Where " & strCriteria & " Group By " & strFields
 CurrentDb.QueryDefs(strQuery).SQL = Mysql
 Me.frmSubProjectActQry.SourceObject = "QUERY." & strQuery
 Me.frmSubProjectActQry.Visible = True
 End Sub

It uses this BuildIn function, (which I think I got from a smarty on this site):

Function BuildIn(lboListBox As ListBox, _
     strFieldName As String, strDelim As String) As String
    'send in a list box control object
    'strFieldName is the name of the field in the report's record source
    'strDelim is the delimiter for numbers use "" for text """" and dates "#"
    Dim strIn As String
    Dim varItem As Variant
        
    If lboListBox.ItemsSelected.Count > 0 Then
        strIn = " AND " & strFieldName & " In ("
        For Each varItem In lboListBox.ItemsSelected
            strIn = strIn & strDelim & lboListBox.ItemData(varItem) & strDelim & ", "
        Next
        'remove the last ", " and add the ")"
        strIn = Left(strIn, Len(strIn) - 2) & ") "
    End If
    BuildIn = strIn
End Function

I tried changing the red line above into the following:

" AND [Client/Customer ID]  In (Select PKProjectClientID From tblProjectClient Where PKProjectClientID = [Client/Customer ID] " & BuildIn(Me.lstClient, "[Client/Customer]", "'")

When I debug the code, I get this for the sql:

SELECT  [Project Name], 
[Project Status], 
[Client/Customer], 
[Client/Customer Type] 
FROM  
qryClientCoProj 
Where 1=1  AND 
[Client/Customer ID]  In (Select PKProjectCustomerID From tblProjectCustomer Where PKProjectCustomerID = [Client/Project ID]  AND [Client/Customer] In ('ABC Group', 'XYZ Inc')  AND 1=1 AND 1=1 AND 1=1 AND 1=1 AND 1=1 AND 1=1 AND 1=1 AND 1=1 Group By [Project Name], [Project Status], [Client/Customer], [Client/Customer Type]

I am not sure how to get what I need. I just know what I want the end result to be. Anyone have any suggestions, I would appreciate it.

Thank you,



misscrf

It is never too late to become what you could have been ~ George Eliot