Help with unbound form to filter report (1 Viewer)

G

gojets1721

Registered User.
Local time
Today, 04:14
Joined
Jun 11, 2019
Messages
430
See the attached example DB. I'm using a unbound form to filter a report. The form has two text fields and a listbox to filter.

I got it working perfectly with only the listbox. When I added in the text fields and associated VBA, I'm now getting a data mismatch error on the openreport line.

I can't seem to figure out what I'm doing wrong. Any suggestions?

Here's the form's code as well:

Code: 
Private Sub btnOpenReport_Click()

    Dim strReportName As String
    Dim strReportView As String
    Dim strCriteria As String
    Dim strSort As String
    Dim strDescrip As String
    Dim lngLen As Long
    Dim varItem As Variant
    Dim strDelim As String
    Dim db As DAO.Database
    Set db = CurrentDb
    
    strDelim = """"
    strReportName = "rptComplaints"
    strReportView = acViewReport
    
    'Customer First Name
    If Not IsNull(Me.txtCustomerFirstName) Then
        strCriteria = strCriteria & "([CustomerFirstName] Like ""*" & Me.txtCustomerFirstName & "*"") AND "
    End If
    
    'Customer Last Name
    If Not IsNull(Me.txtCustomerLastName) Then
        strCriteria = strCriteria & "([CustomerLastName] Like ""*" & Me.txtCustomerLastName & "*"") AND "
    End If
    
    'Complaint Category
    With Me.listComplaintCategory
        For Each varItem In .ItemsSelected
            If Not IsNull(varItem) Then
                strCriteria = strCriteria & strDelim & .ItemData(varItem) & strDelim & ","
                strDescrip = strDescrip & """" & .Column(1, varItem) & """, "
            End If
        Next
    End With
    
    lngLen = Len(strCriteria) - 1
    If lngLen > 0 Then
        strCriteria = "[ComplaintCategory] IN (" & Left$(strCriteria, lngLen) & ")"
        lngLen = Len(strDescrip) - 2
        If lngLen > 0 Then
            strDescrip = "Categories: " & Left$(strDescrip, lngLen)
        End If
    End If
    
    'Report will not filter if open, so close it.
    If CurrentProject.AllReports(strReportName).IsLoaded Then
        DoCmd.Close acReport, strReportName
    End If
    
    DoCmd.OpenReport strReportName, strReportView, , strCriteria, , strSort
    
End Sub
 

Attachments

  • Example23.accdb
    580 KB · Views: 73
J

Josef P.

Well-known member
Local time
Today, 13:14
Joined
Feb 2, 2023
Messages
826
Code slightly reworked:
Code: 
Private Sub btnOpenReport_Click()


    Dim strReportName As String
    Dim ReportView As AcView                    ' <---
    Dim strCriteria As String
    Dim strComplaintCategoryCriteria As String  ' <---
    Dim strSort As String
    'Dim strDescrip As String
    'Dim lngLen As Long
    Dim varItem As Variant
    'Dim strDelim As String
    'Dim db As DAO.Database
    'Set db = CurrentDb
  
    'strDelim = """"
    strReportName = "rptComplaints"
    ReportView = AcView.acViewReport
  
    'Customer First Name
    With Me.txtCustomerFirstName
      If Len(.Value) > 0 Then
          strCriteria = strCriteria & " AND [CustomerFirstName] Like '*" & Replace(.Value, "'", "''") & "*'"
      End If
    End With
  
    'Customer Last Name
    With Me.txtCustomerLastName
      If Len(.Value) > 0 Then
          strCriteria = strCriteria & " AND [CustomerLastName] Like '*" & Replace(.Value, "'", "''") & "*'"
      End If
    End With
  
  
    'Complaint Category
    With Me.listComplaintCategory
        For Each varItem In .ItemsSelected
            strComplaintCategoryCriteria = strComplaintCategoryCriteria & ",'" & .ItemData(varItem) & "'"
            'strDescrip = strDescrip & """" & .Column(1, varItem) & """, "
        Next
    End With
    If Len(strComplaintCategoryCriteria) > 0 Then
        strCriteria = strCriteria & " AND [ComplaintCategory] IN (" & Mid(strComplaintCategoryCriteria, 2) & ")"
    End If
  
' strDescrip is used for?
'    lngLen = Len(strCriteria) - 1
'    If lngLen > 0 Then
'        strCriteria = "[ComplaintCategory] IN (" & Left$(strCriteria, lngLen) & ")"
'        lngLen = Len(strDescrip) - 2
'        If lngLen > 0 Then
'            strDescrip = "Categories: " & Left$(strDescrip, lngLen)
'        End If
'    End If

    If Len(strCriteria) > 0 Then
      strCriteria = Mid(strCriteria, Len(" And "))
    End If
  
Debug.Print "strCriteria: """ & strCriteria & """"
  
    'Report will not filter if open, so close it.
    If CurrentProject.AllReports(strReportName).IsLoaded Then
        DoCmd.Close acReport, strReportName
    End If
  
'    strSort .. not filled
    DoCmd.OpenReport strReportName, ReportView, , strCriteria, , strSort
  
End Sub

/edit:
With the use of a filter class, it could look like this:
(Example see attachement, filter class: FilterStringBuilder)
Code: 
Private Sub btnOpenReport_Click()

    Dim strReportName As String
    Dim ReportView As AcView                    ' <---
    Dim strCriteria As String
    Dim strSort As String
   
    strReportName = "rptComplaints"
    ReportView = AcView.acViewReport
 
    strCriteria = GetFilterStringWithFilterStringBuilder
Debug.Print "strCriteria: """ & strCriteria & """"
   
    'Report will not filter if open, so close it.
    If CurrentProject.AllReports(strReportName).IsLoaded Then
        DoCmd.Close acReport, strReportName
    End If
   
'    strSort .. not filled
    DoCmd.OpenReport strReportName, ReportView, , strCriteria, , strSort

End Sub

Private Function GetFilterStringWithFilterStringBuilder() As String

    Dim varItem As Variant
    Dim SelectedComplaintCategories As StringCollection
     
    With New FilterStringBuilder
   
       .ConfigSqlFormat "\#yyyy-mm-dd hh:nn:ss\#", "True", "*"
     
       'Customer First Name
       .Add "CustomerFirstName", SQL_Text, SQL_Like + SQL_Add_WildCardPrefix + SQL_Add_WildCardSuffix, Me.txtCustomerFirstName.Value
     
       'Customer Last Name
       .Add "CustomerLastName", SQL_Text, SQL_Like + SQL_Add_WildCardPrefix + SQL_Add_WildCardSuffix, Me.txtCustomerLastName.Value
     
       'Complaint Category
       Set SelectedComplaintCategories = New StringCollection
       With Me.listComplaintCategory
           For Each varItem In .ItemsSelected
               SelectedComplaintCategories.Add .ItemData(varItem)
           Next
       End With
       .Add "ComplaintCategory", SQL_Text, SQL_In, SelectedComplaintCategories.ToStringArray(True, False)
     
       GetFilterStringWithFilterStringBuilder = .ToString(SQL_And)
    End With

End Function
 

Attachments

  • Example23-2.zip
    104.4 KB · Views: 84
Last edited:
moke123

moke123

AWF VIP
Local time
Today, 07:14
Joined
Jan 11, 2013
Messages
3,920
you need another variable to handle the values in you multi-select listbox and then add it to the filter criteria
 
G

gojets1721

Registered User.
Local time
Today, 04:14
Joined
Jun 11, 2019
Messages
430
Josef P. said:
Code slightly reworked:
Code: 
Private Sub btnOpenReport_Click()


    Dim strReportName As String
    Dim ReportView As AcView                    ' <---
    Dim strCriteria As String
    Dim strComplaintCategoryCriteria As String  ' <---
    Dim strSort As String
    'Dim strDescrip As String
    'Dim lngLen As Long
    Dim varItem As Variant
    'Dim strDelim As String
    'Dim db As DAO.Database
    'Set db = CurrentDb
 
    'strDelim = """"
    strReportName = "rptComplaints"
    ReportView = AcView.acViewReport
 
    'Customer First Name
    With Me.txtCustomerFirstName
      If Len(.Value) > 0 Then
          strCriteria = strCriteria & " AND [CustomerFirstName] Like '*" & Replace(.Value, "'", "''") & "*'"
      End If
    End With
 
    'Customer Last Name
    With Me.txtCustomerLastName
      If Len(.Value) > 0 Then
          strCriteria = strCriteria & " AND [CustomerLastName] Like '*" & Replace(.Value, "'", "''") & "*'"
      End If
    End With
 
 
    'Complaint Category
    With Me.listComplaintCategory
        For Each varItem In .ItemsSelected
            strComplaintCategoryCriteria = strComplaintCategoryCriteria & ",'" & .ItemData(varItem) & "'"
            'strDescrip = strDescrip & """" & .Column(1, varItem) & """, "
        Next
    End With
    If Len(strComplaintCategoryCriteria) > 0 Then
        strCriteria = strCriteria & " AND [ComplaintCategory] IN (" & Mid(strComplaintCategoryCriteria, 2) & ")"
    End If
 
' strDescrip is used for?
'    lngLen = Len(strCriteria) - 1
'    If lngLen > 0 Then
'        strCriteria = "[ComplaintCategory] IN (" & Left$(strCriteria, lngLen) & ")"
'        lngLen = Len(strDescrip) - 2
'        If lngLen > 0 Then
'            strDescrip = "Categories: " & Left$(strDescrip, lngLen)
'        End If
'    End If

    If Len(strCriteria) > 0 Then
      strCriteria = Mid(strCriteria, Len(" And "))
    End If
 
Debug.Print "strCriteria: """ & strCriteria & """"
 
    'Report will not filter if open, so close it.
    If CurrentProject.AllReports(strReportName).IsLoaded Then
        DoCmd.Close acReport, strReportName
    End If
 
'    strSort .. not filled
    DoCmd.OpenReport strReportName, ReportView, , strCriteria, , strSort
 
End Sub

/edit:
With the use of a filter class, it could look like this:
(Example see attachement, filter class: FilterStringBuilder)
Code: 
Private Sub btnOpenReport_Click()

    Dim strReportName As String
    Dim ReportView As AcView                    ' <---
    Dim strCriteria As String
    Dim strSort As String
  
    strReportName = "rptComplaints"
    ReportView = AcView.acViewReport

    strCriteria = GetFilterStringWithFilterStringBuilder
Debug.Print "strCriteria: """ & strCriteria & """"
  
    'Report will not filter if open, so close it.
    If CurrentProject.AllReports(strReportName).IsLoaded Then
        DoCmd.Close acReport, strReportName
    End If
  
'    strSort .. not filled
    DoCmd.OpenReport strReportName, ReportView, , strCriteria, , strSort

End Sub

Private Function GetFilterStringWithFilterStringBuilder() As String

    Dim varItem As Variant
    Dim SelectedComplaintCategories As StringCollection
    
    With New FilterStringBuilder
  
       .ConfigSqlFormat "\#yyyy-mm-dd hh:nn:ss\#", "True", "*"
    
       'Customer First Name
       .Add "CustomerFirstName", SQL_Text, SQL_Like + SQL_Add_WildCardPrefix + SQL_Add_WildCardSuffix, Me.txtCustomerFirstName.Value
    
       'Customer Last Name
       .Add "CustomerLastName", SQL_Text, SQL_Like + SQL_Add_WildCardPrefix + SQL_Add_WildCardSuffix, Me.txtCustomerLastName.Value
    
       'Complaint Category
       Set SelectedComplaintCategories = New StringCollection
       With Me.listComplaintCategory
           For Each varItem In .ItemsSelected
               SelectedComplaintCategories.Add .ItemData(varItem)
           Next
       End With
       .Add "ComplaintCategory", SQL_Text, SQL_In, SelectedComplaintCategories.ToStringArray(True, False)
    
       GetFilterStringWithFilterStringBuilder = .ToString(SQL_And)
    End With

End Function
Click to expand...
This worked perfectly!! Thanks so much!!
 
G

gojets1721

Registered User.
Local time
Today, 04:14
Joined
Jun 11, 2019
Messages
430
@Josef P. Could you take a look at the below? I used your code and it worked, but I added in one more element and I'm getting an error.

It's the employee responsible section. This code is intended to select records for the report based on the criteria matching another table.

I can't get it to work with your code. I'm getting a 3075 syntax error (comma) on the openreport line

Any suggestions?

Code: 
Private Sub btnOpenReport_Click()

    Dim strReportName As String
    Dim ReportView As AcView
    Dim strCriteria As String
    Dim strComplaintCategoryCriteria As String
    Dim strSort As String
    Dim varItem As Variant
    Dim strDelim As String
    Dim db As DAO.Database
    Set db = CurrentDb

    strReportName = "rptComplaints"
    ReportView = AcView.acViewReport

    'Employee Responsible
    If Not IsNull(Me.txtEmployeeResponsible) Then
        With db.OpenRecordset("select ComplaintNumber From tblEmployees Where EmployeeName like '*" & Me.txtEmployeeResponsible & "*'")
            If Not (.BOF And .EOF) Then
                .MoveFirst
                strCriteria = ""
                Do While Not .EOF
                    strCriteria = strCriteria & !ComplaintNumber & ","
                    .MoveNext
                Loop
                strCriteria = Left$(strCriteria, Len(strCriteria) - 1)
            End If
        End With
    End If

    'Customer First Name
    With Me.txtCustomerFirstName
      If Len(.Value) > 0 Then
          strCriteria = strCriteria & " AND [CustomerFirstName] Like '*" & Replace(.Value, "'", "''") & "*'"
      End If
    End With

    'Customer Last Name
    With Me.txtCustomerLastName
      If Len(.Value) > 0 Then
          strCriteria = strCriteria & " AND [CustomerLastName] Like '*" & Replace(.Value, "'", "''") & "*'"
      End If
    End With

    'Complaint Category
    With Me.listComplaintCategory
        For Each varItem In .ItemsSelected
            strComplaintCategoryCriteria = strComplaintCategoryCriteria & ",'" & .ItemData(varItem) & "'"
            'strDescrip = strDescrip & """" & .Column(1, varItem) & """, "
        Next
    End With
    If Len(strComplaintCategoryCriteria) > 0 Then
        strCriteria = strCriteria & " AND [ComplaintCategory] IN (" & Mid(strComplaintCategoryCriteria, 2) & ")"
    End If


    If Len(strCriteria) > 0 Then
      strCriteria = Mid(strCriteria, Len(" And "))
    End If

Debug.Print "strCriteria: """ & strCriteria & """"

    If CurrentProject.AllReports(strReportName).IsLoaded Then
        DoCmd.Close acReport, strReportName
    End If

    DoCmd.OpenReport strReportName, ReportView, , strCriteria, , strSort

End Sub
 
MajP

MajP

You've got your good things, and you've got mine.
Local time
Today, 07:14
Joined
May 21, 2018
Messages
8,529
how about a debug.print strCriteria so we can see what the issue is?
 
G

gojets1721

Registered User.
Local time
Today, 04:14
Joined
Jun 11, 2019
Messages
430
I dropped in this debug line:

Code: 
Debug.Print "strCriteria: """ & strCriteria & """"

When I try to use the employee responsible field with 'John', the immediate window is:

Code: 
strCriteria: "7,9"
 
MajP

MajP

You've got your good things, and you've got mine.
Local time
Today, 07:14
Joined
May 21, 2018
Messages
8,529
That should answer your question. You should be building something like:

ComplaintNumber in (7,9)

Which is the same code as here

Solved - Form to add data to multiple records

See the attached DB. I'm trying to come up with a form that will update multiple records with a single line that the user inputs. So in the example, I'm hoping to allow the user to put in multiple complaint numbers, and then type out whatever they want in the follow-up field. Then once the...
www.access-programmers.co.uk
 
Last edited:
J

Josef P.

Well-known member
Local time
Today, 13:14
Joined
Feb 2, 2023
Messages
826
gojets1721 said:
'Employee Responsible
If Not IsNull(Me.txtEmployeeResponsible) Then
With db.OpenRecordset("select ComplaintNumber From tblEmployees Where EmployeeName like '*" & Me.txtEmployeeResponsible & "*'")
If Not (.BOF And .EOF) Then
.MoveFirst
strCriteria = ""
Do While Not .EOF
strCriteria = strCriteria & !ComplaintNumber & ","
.MoveNext
Loop
strCriteria = Left$(strCriteria, Len(strCriteria) - 1)
End If
End With
End If
Click to expand...
Why are you using strCtriteria again here to compose the in expression?

Tip: outsource more complex code blocks to extra procedures.
Code: 
private function GetResponsibleFilter(byval EmployeeName as String) as String
     dim strCriteria as String
     With CurrentDb.OpenRecordset("select ComplaintNumber From tblEmployees Where EmployeeName like '*" & EmployeeName & "*'")
                Do While Not .EOF
                    strCriteria = strCriteria & !ComplaintNumber & ","
                    .MoveNext
                Loop
        End With

       if len(strCriteria) > 0 then
              strCriteria = "ComplaintNumber in (" & Left$(strCriteria, Len(strCriteria) - 1) & ")"
       end if

       GetResponsibleFilter = strCriteria

end function

usage in btnOpenReport_Click:
Code: 
'Employee Responsible
    If Not IsNull(Me.txtEmployeeResponsible) Then
        strCriteria = strCriteria & " AND " & GetResponsibleFilter(Me.txtEmployeeResponsible)
    End If
 
Last edited:
G

gojets1721

Registered User.
Local time
Today, 04:14
Joined
Jun 11, 2019
Messages
430
Josef P. said:
Why are you using strCtriteria again here to compose the in expression?

Tip: outsource more complex code blocks to extra procedures.
Code: 
private function GetResponsibleFilter(byval EmployeeName as String) as String
     dim strCriteria as String
     With CurrentDb.OpenRecordset("select ComplaintNumber From tblEmployees Where EmployeeName like '*" & EmployeeName & "*'")
                Do While Not .EOF
                    strCriteria = strCriteria & !ComplaintNumber & ","
                    .MoveNext
                Loop
        End With

       if len(strCriteria) > 0 then
              strCriteria = "ComplaintNumber in (" & Left$(strCriteria, Len(strCriteria) - 1) & ")"
       end if

       GetResponsibleFilter = strCriteria

end function

usage in btnOpenReport_Click:
Code: 
'Employee Responsible
    If Not IsNull(Me.txtEmployeeResponsible) Then
        strCriteria = strCriteria & " AND " & GetResponsibleFilter(Me.txtEmployeeResponsible)
    End If
Click to expand...
This worked!! Thanks so much
 
You must log in or register to reply here.

Similar threads

M
Solved Syntex Error
Replies
12
Views
773
Josef P.
J
oxicottin
Cant get form filter to work correctly
Replies
8
Views
218
plog
P
G
Help with unbound filter form code
Replies
2
Views
391
gojets1721
G
smtazulislam
Solved Unbound Combo box need multiple value
2
Replies
20
Views
1,787
smtazulislam
smtazulislam
F
Search form
Replies
4
Views
601
bastanu
bastanu

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom