locked
Mulitselect listboxes for a report RRS feed

  • Question

  • Can someone find where my code is wrong on this vba procedure ?

                                   

    Private Sub cmdReport3_Click()
    'open fumigant delivery report based on field and season
        Dim strGrower As String
        Dim strSeason As String
        Dim ctL3 As Control
        Dim varItem3 As Variant
        Dim ctL33 As Control
        Dim varItem33 As Variant

        If Me.ListCustomers.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Grower Field."
        Exit Sub
        End If
        Set ctL3 = Me.ListCustomers
        For Each varItem3 In ctL3.ItemsSelected
        strGrower = strGrower & "" & ctL3.ItemData(varItem3) & "'"

        Next varItem3

        If Me.ListSeason.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Season Field."
        Exit Sub
        End If
        Set ctL33 = Me.ListSeason
        For Each varItem33 In ctL33.ItemsSelected
        strSeason = strSeason & "" & ctL33.ItemData(varItem33) & "'"

        Next varItem33



        DoCmd.OpenReport "Fumigant Delivery Report", acViewReport, "Fumigant Delivery Query2", "Grower In(" & strGrower & ") And Season In(" & strSeason & ")"

        DoCmd.Close acForm, "Fumigant Delivery Report Dialog"

    I get a debug in the DoCmd openReport line. please Help.

    Thanks,

    Wednesday, September 27, 2017 9:41 PM

Answers

  • Thanks for your reply. I did change the Lines as Suggested by both replies.

    But still get a debug statement, see below.

                                   

    Private Sub cmdReport3_Click()
    'open fumigant delivery report based on field and season
        Dim strGrower As String
        Dim strSeason As String
        Dim ctL3 As Control
        Dim varItem3 As Variant
        Dim ctL33 As Control
        Dim varItem33 As Variant

        If Me.ListCustomers.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Grower Field."
        Exit Sub
        End If
        Set ctL3 = Me.ListCustomers
        For Each varItem3 In ctL3.ItemsSelected
        strGrower = strGrower & ",'" & ctL3.ItemData(varItem3) & "'"

        Next varItem3
        strGrower = Mid(strGrower, 2)

        If Me.ListSeason.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Season Field."
        Exit Sub
        End If
        Set ctL33 = Me.ListSeason
        For Each varItem33 In ctL33.ItemsSelected
        strSeason = strSeason & ",'" & ctL33.ItemData(varItem33) & """"

        Next varItem33
        strSeason = Mid(strSeason, 2)


        DoCmd.OpenReport "Fumigant Delivery Report", acViewReport, "Fumigant Delivery Query2", "Grower In(" & strGrower & ") And Season In(" & strSeason & ")"

        DoCmd.Close acForm, "Fumigant Delivery Report Dialog"

    End Sub

    "syntax error in string in query expression for  'strgrower and strseason' for open report"

    • Marked as answer by kahlotus Thursday, September 28, 2017 1:27 AM
    Wednesday, September 27, 2017 10:06 PM
  • Thanks for the reply's. Stil have a an error in the docmd print report

    I tried the debug.print window and nothing showed up there in the immediate window.

    Private Sub cmdReport3_Click()
    'open fumigant delivery report based on field and season
        Dim strGrower As String
        Dim strSeason As String
        Dim ctL3 As Control
        Dim varItem3 As Variant
        Dim ctL33 As Control
        Dim varItem33 As Variant
        
        If Me.ListCustomers.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Grower Field."
        Exit Sub
        End If
        Set ctL3 = Me.ListCustomers
        For Each varItem3 In ctL3.ItemsSelected
        strGrower = strGrower & ",'" & ctL3.ItemData(varItem3) & "'"
        Debug.Print strGrower
        
        Next varItem3
        strGrower = Mid(strGrower, 2)
        
        
        If Me.ListSeason.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Season Field."
        Exit Sub
        End If
        Set ctL33 = Me.ListSeason
        For Each varItem33 In ctL33.ItemsSelected
        strSeason = strSeason & ","" & ctL33.ItemData(varItem33) & """""
        Debug.Print strSeason
        
        Next varItem33
        strSeason = Mid(strSeason, 2)
       
        Debug.Print strSeason
        
        DoCmd.OpenReport "Fumigant Delivery Report", acViewReport, "Fumigant Delivery Query2", "Grower In(" & strGrower & ") And Season In(" & strSeason & ")"
        
        DoCmd.Close acForm, "Fumigant Delivery Report Dialog"
        
      
        
        
    End Sub

    • Marked as answer by kahlotus Thursday, September 28, 2017 1:32 AM
    Thursday, September 28, 2017 1:30 AM
  • This did show up in the immediate window this time.

     ,'Diamondback JV'
    ," & ctL33.ItemData(varItem33) & ""
    " & ctL33.ItemData(varItem33) & ""

    Not sure what it means just yet.

    Thanks,

    • Marked as answer by kahlotus Thursday, September 28, 2017 1:36 AM
    Thursday, September 28, 2017 1:36 AM

All replies

  • Hi,

    I think you're missing the comma separators. Try changing the following two lines:

    strGrower = strGrower & "'" & ctL3.ItemData(varItem3) &"',"

    and

    strSeason = strSeason & "'" & ctL33.ItemData(varItem33) & "',"

    Hope it helps...

    Wednesday, September 27, 2017 9:46 PM
  • Change

        For Each varItem3 In ctL3.ItemsSelected
         strGrower = strGrower & "" & ctL3.ItemData(varItem3) & "'"
         Next varItem3

    to

        For Each varItem3 In ctL3.ItemsSelected
             strGrower = strGrower & ",'" & ctL3.ItemData(varItem3) & "'"
        Next varItem3
        strGrower = Mid(strGrower, 2)

    and similar for strSeason.


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Wednesday, September 27, 2017 9:48 PM
  • Thanks for your reply. I did change the Lines as Suggested by both replies.

    But still get a debug statement, see below.

                                   

    Private Sub cmdReport3_Click()
    'open fumigant delivery report based on field and season
        Dim strGrower As String
        Dim strSeason As String
        Dim ctL3 As Control
        Dim varItem3 As Variant
        Dim ctL33 As Control
        Dim varItem33 As Variant

        If Me.ListCustomers.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Grower Field."
        Exit Sub
        End If
        Set ctL3 = Me.ListCustomers
        For Each varItem3 In ctL3.ItemsSelected
        strGrower = strGrower & ",'" & ctL3.ItemData(varItem3) & "'"

        Next varItem3
        strGrower = Mid(strGrower, 2)

        If Me.ListSeason.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Season Field."
        Exit Sub
        End If
        Set ctL33 = Me.ListSeason
        For Each varItem33 In ctL33.ItemsSelected
        strSeason = strSeason & ",'" & ctL33.ItemData(varItem33) & """"

        Next varItem33
        strSeason = Mid(strSeason, 2)


        DoCmd.OpenReport "Fumigant Delivery Report", acViewReport, "Fumigant Delivery Query2", "Grower In(" & strGrower & ") And Season In(" & strSeason & ")"

        DoCmd.Close acForm, "Fumigant Delivery Report Dialog"

    End Sub

    "syntax error in string in query expression for  'strgrower and strseason' for open report"

    • Marked as answer by kahlotus Thursday, September 28, 2017 1:27 AM
    Wednesday, September 27, 2017 10:06 PM
  • Hi,

    Can you add the following lines and tell us what shows up? Thanks.

    Debug.Print strGrower

    and

    Debug.Print strSeason

    Also, does your code work if you only select one grower and one season? Just curious...


    PS. One more question... What are the datatypes for your fields Grower and Season?
    • Edited by .theDBguy Wednesday, September 27, 2017 10:16 PM
    Wednesday, September 27, 2017 10:15 PM
  • In the case of the seasons list box you are representing the quotes delimiter by a single quote character in the case of the opening delimiter, and a pair of contiguous quotes characters in the case of the closing delimiter:  Change the line as follows so that they match:

        strSeason = strSeason & ",""" & ctL33.ItemData(varItem33) & """"

    Ken Sheridan, Stafford, England

    Wednesday, September 27, 2017 10:48 PM
  • Thanks for the reply's. Stil have a an error in the docmd print report

    I tried the debug.print window and nothing showed up there in the immediate window.

    Private Sub cmdReport3_Click()
    'open fumigant delivery report based on field and season
        Dim strGrower As String
        Dim strSeason As String
        Dim ctL3 As Control
        Dim varItem3 As Variant
        Dim ctL33 As Control
        Dim varItem33 As Variant
        
        If Me.ListCustomers.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Grower Field."
        Exit Sub
        End If
        Set ctL3 = Me.ListCustomers
        For Each varItem3 In ctL3.ItemsSelected
        strGrower = strGrower & ",'" & ctL3.ItemData(varItem3) & "'"
        Debug.Print strGrower
        
        Next varItem3
        strGrower = Mid(strGrower, 2)
        
        
        If Me.ListSeason.ItemsSelected.Count = 0 Then
        MsgBox "You must select at least 1 Season Field."
        Exit Sub
        End If
        Set ctL33 = Me.ListSeason
        For Each varItem33 In ctL33.ItemsSelected
        strSeason = strSeason & ","" & ctL33.ItemData(varItem33) & """""
        Debug.Print strSeason
        
        Next varItem33
        strSeason = Mid(strSeason, 2)
       
        Debug.Print strSeason
        
        DoCmd.OpenReport "Fumigant Delivery Report", acViewReport, "Fumigant Delivery Query2", "Grower In(" & strGrower & ") And Season In(" & strSeason & ")"
        
        DoCmd.Close acForm, "Fumigant Delivery Report Dialog"
        
      
        
        
    End Sub

    • Marked as answer by kahlotus Thursday, September 28, 2017 1:32 AM
    Thursday, September 28, 2017 1:30 AM
  • This did show up in the immediate window this time.

     ,'Diamondback JV'
    ," & ctL33.ItemData(varItem33) & ""
    " & ctL33.ItemData(varItem33) & ""

    Not sure what it means just yet.

    Thanks,

    • Marked as answer by kahlotus Thursday, September 28, 2017 1:36 AM
    Thursday, September 28, 2017 1:36 AM
  • Debug statement.

    ,'Diamondback JV'
    ," & ctL33.ItemData(varItem33) & ""
    " & ctL33.ItemData(varItem33) & ""

    Both are short text data types.

    Thanks,

    Thursday, September 28, 2017 1:38 AM
  • It does not work with one selection only.
    Thursday, September 28, 2017 1:39 AM
  • Try this:

    Private Sub cmdReport3_Click()

        'open fumigant delivery report based on field and season
        Dim strGrower As String
        Dim strCriteria1 As String
        Dim strCriteria2 As String
        Dim strCriteria As String
        Dim varItem3 As Variant
        Dim varItem33 As Variant
        
        With Me.ListCustomers
            If  .ItemsSelected.Count = 0 Then
                MsgBox "You must select at least 1 Grower Field."
                Exit Sub       
            Else
                For Each varItem3 In .ItemsSelected
                    ' Edit: closing quotes corrected
                    strCriteria1 = strCriteria1 & ",""" & .ItemData(varItem3) & """"    
                Next varItem3
                ' Edit: column name corrected:
                strCriteria1 = "Grower In(" &Mid(strCriteria , 2) & ")"
            End If
         End With   
        
        With Me.ListSeason
            If .ItemsSelected.Count = 0 Then
                MsgBox "You must select at least 1 Season Field."   
                Exit Sub     
            Else
                For Each varItem33 In .ItemsSelected
                    strCriteria2 =  strCriteria2 & ",""" & .ItemData(varItem33) & """"    
                Next varItem33
                 strCriteria2 = "Season In " & Mid(strSeason, 2) & ")"
           End If
        End With

        strCriteria = strCriteria1 & " And " & strCriteria2
        
        DoCmd.OpenReport  "Fumigant Delivery Report", _
            View:=acViewReport, _
            WhereCondition:=strCriteria
        
        DoCmd.Close acForm, "Fumigant Delivery Report Dialog"
        
    End Sub
    • Edited by Ken Sheridan Thursday, September 28, 2017 4:45 PM As remarked in code.
    Thursday, September 28, 2017 9:49 AM
  • Note edit to my last reply.

    Ken Sheridan, Stafford, England

    Thursday, September 28, 2017 4:40 PM
  • Thanks Ken,

    For your help.

    But still getting debug on the Do.cmd print statement.

    Researching on using MultlpleValueCriteria function.

    I have one for a single list box with Multiple values but trying to do more than one listbox.

    First click event:

    Private Sub cmdreport6_Click()
    'fumigant delivery report on all product used in a season
         Call MultipleValueCriteria(Me, Me!ListSeason, "Season")
    End Sub

    Then the Function:

    Function MultipleValueCriteria(pform As Form, pcontrol As ListBox, pfield As String)
      'Launch Fumigant Delivery Report
      'Or criteria built on field
      'passed by pfield;
      
      Dim var As Variant
      Dim strSeason As String
      If pcontrol.ItemsSelected.Count = 0 Then
        MsgBox "Please select a Season.", _
         vbOKOnly, "          WAIT !"
        Exit Function
      'Build a SQL statement using
      'selected Seasons.
      Else
        'Criteria expression uses literal string
        'values. If using numeric or date values,
        'update delimiter component.
        For Each var In pcontrol.ItemsSelected
          strSeason = strSeason & _
           pfield & " = '" & _
           pcontrol.ItemData(var) _
           & "' Or "
        Next var
      End If
      strSeason = Left(strSeason, _
       Len(strSeason) - 4)
      Debug.Print strSeason
      'Open Fumigant Delivered filtered report and close form.
      DoCmd.OpenReport "Fumigant Delivery Report", acViewReport, , strSeason
      DoCmd.Close acForm, "Fumigant Delivery Report Dialog 2"
      Set pform = Nothing
      Set pcontrol = Nothing

    End Function

    This works good one list box, but trying to to do more than one.

    Thank you, Rick

    Thursday, September 28, 2017 5:13 PM
  • Have you tried my corrected code as written?  If so, do you get an error and, if so, what is the value of the strCriteria variable if you debug the code?

    I do have an example of two multi-select list boxes in MultiSelect.zip in my public databases folder at:

    https://onedrive.live.com/?cid=44CC60D7FEA42912&id=44CC60D7FEA42912!169

    Note that if you are using an earlier version of Access you might find that the colour of some form objects such as buttons shows incorrectly and you will need to  amend the form design accordingly.  

    If you have difficulty opening the link copy its text (NB, not the link location) and paste it into your browser's address bar.

    However my example works in a very different way, by referencing two unbound controls in the dialogue form as parameters by means of a couple of functions published by Microsoft.  The example in the demo is that to  'Filter Report on Multiple values from Fields, combined with AND
    Where Employee Is Assigned to All Selected Projects'.  The code in the dialogue form's module is:

    Option Compare Database
    Option Explicit

    Private Sub cmdClearSelectedProjects_Click()

        Dim n As Integer
        
        With Me.lstProjects
            For n = 0 To .ListCount - 1
                .Selected(n) = False
            Next n
        End With
        
        lstProjects_AfterUpdate

    End Sub

    Private Sub cmdClearSelections_Click()

        Dim n As Integer
        
        With Me.lstEmployees
            For n = 0 To .ListCount - 1
                .Selected(n) = False
            Next n
        End With

        lstEmployees_AfterUpdate

    End Sub

    Private Sub cmdOpenReport_Click()

        Dim strCriteria As String
        
        strCriteria = "EmployeeID IN" & _
                "(SELECT EmployeeID FROM qryEmployeeExtendedDlg_BOTH)"
            
        DoCmd.OpenReport "rptEmployees", _
                View:=acViewPreview, _
                WhereCondition:=strCriteria
                
    End Sub


    Private Sub cmdSelectAll_Click()

        Dim n As Integer
        
        With Me.lstEmployees
            For n = 0 To .ListCount - 1
                .Selected(n) = True
            Next n
        End With
        
        lstEmployees_AfterUpdate
        
    End Sub


    Private Sub cmdSelectAllProjects_Click()

        Dim n As Integer
        
        With Me.lstProjects
            For n = 0 To .ListCount - 1
                .Selected(n) = True
            Next n
        End With

        lstProjects_AfterUpdate
        
    End Sub

    Private Sub Form_Close()

        On Error Resume Next
        Forms("frmOpen").Visible = True
        
    End Sub


    Private Sub lstEmployees_AfterUpdate()

        Dim varItem As Variant
        Dim strEmployeeIDList As String
        Dim ctrl As Control
        
        Set ctrl = Me.lstEmployees
        Me.txtEmployeeIDList = Null
        
        For Each varItem In ctrl.ItemsSelected
            strEmployeeIDList = strEmployeeIDList & "," & ctrl.ItemData(varItem)
        Next varItem
            
        ' remove leading comma if necessary
        If strEmployeeIDList <> "" Then
            strEmployeeIDList = Mid(strEmployeeIDList, 2)
        End If
            
        Me.txtEmployeeIDList = strEmployeeIDList
            

    End Sub


    Private Sub lstProjects_AfterUpdate()

        Dim varItem As Variant
        Dim strProjectIDList As String
        Dim ctrl As Control
        
        Set ctrl = Me.lstProjects
        Me.txtProjectIDList = Null
        
        For Each varItem In ctrl.ItemsSelected
            strProjectIDList = strProjectIDList & "," & ctrl.ItemData(varItem)
        Next varItem
            
        ' remove leading comma if necessary
        If strProjectIDList <> "" Then
            strProjectIDList = Mid(strProjectIDList, 2)
        End If
            
        Me.txtProjectIDList = strProjectIDList

    End Sub
    ' module ends

    The query referenced in the cmdOpenReport button's Click event procedure is:

    SELECT Employees.EmployeeID
    FROM Employees INNER JOIN ProjectEmployees
    ON Employees.EmployeeID=ProjectEmployees.EmployeeID
    WHERE InParam(Employees.EmployeeID,Forms!frmEmployeeExtendedDlg_BOTH!txtEmployeeIDList)
    AND InParam(ProjectID,Forms!frmEmployeeExtendedDlg_BOTH!txtProjectIDList)
    GROUP BY Employees.EmployeeID
    HAVING COUNT(*)=Forms!frmEmployeeExtendedDlg_BOTH!lstProjects.ItemsSelected.Count;

    and the functions from Microsoft called by the query are:

    Function GetToken(stLn, stDelim)
         
        Dim iDelim As Integer, stToken As String
        
        iDelim = InStr(1, stLn, stDelim)
        
        If (iDelim <> 0) Then
            stToken = LTrim$(RTrim$(Mid$(stLn, 1, iDelim - 1)))
            stLn = Mid$(stLn, iDelim + 1)
        Else
            stToken = LTrim$(RTrim$(Mid$(stLn, 1)))
            stLn = ""
        End If
        
        GetToken = stToken
        
    End Function

    '============================================================
    ' The InParam() function is the heart of this article. When
    ' the query runs, this function causes a query parameter
    ' dialog box to appear so you can enter a list of values.
    ' The values you enter are interpreted as if you
    ' had entered them within the parentheses of the In() operator.
    '============================================================
    Function InParam(Fld, Param)

        Dim stToken As String
        'The following two lines are optional, making queries
        'case-insensitive
        Fld = UCase(Fld)
        Param = UCase(Param)
        
        If IsNull(Fld) Then Fld = ""
            Do While (Len(Param) > 0)
            stToken = GetToken(Param, ",")
            If stToken = LTrim$(RTrim$(Fld)) Then
                InParam = -1
                Exit Function
            Else
                InParam = 0
            End If
        Loop

    End Function

    Ken Sheridan, Stafford, England

    Thursday, September 28, 2017 5:50 PM
  • Have you tried my corrected code as written?  If so, do you get an error and, if so, what is the value of the strCriteria variable if you debug the code?

    I did get an error, but did not debug it. It shows yellow on the DoCmd. print line.

    Will try it  later.  having to work now, darn it...

    Will also look at your link when I have time.

    Thank you very much..

    Rick

    Thursday, September 28, 2017 6:01 PM