Answered by:
Mulitselect listboxes for a report

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 SubThen 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 FunctionThis 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 FunctionKen 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