Multi-Select List Box

[Uninvisible]

I have developed a form for generating reports. Users have an option
to select criteria as well as the option to export to an excel
template or Access report. The problem I am having is that even
though "multi-select" is enabled for my list boxes, reports will only
generate when one selection is made. So, for instance, in the below
example, the filed "STATUS" is a multi-select list box, but only when
one status is selected will a report generate. Any assistance in
being able to enable a multi-select list box would be appreciated.

On Error Resume Next
Dim sCriteria As String
Dim db As Database
Dim rst As Recordset
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim Path As String

sCriteria = " 1 = 1 "

If STATUS <> "" Then
sCriteria = sCriteria & " AND QRY_RPT_TICKLER.STATUS =
""" & STATUS & """"
End If

If StartDate <> "" And EndDate <> "" Then
sCriteria = sCriteria & " AND QRY_RPT_TICKLER.
[DT_FILE_RVW] between #" & Format(StartDate, "dd-mmm-yyyy") & "# and
#" & Format(EndDate, "dd-mmm-yyyy") & "#"
End If

Dim stDocName As String
Select Case RPT_OPS
Case 1 'When the Access option is selected, loads the
Tickler Report
DoCmd.Minimize
DoCmd.OpenReport "RPT_TICKLER_MONTH", acViewPreview, ,
sCriteria

Case 2 'when the Excel option is selested, excel is opened
and the dataset populates the Excel template
Set db = CurrentDb()

Set objBook =
Workbooks.Add(template:=CurrentProject.Path &
"\VanCleef_File_Tickler.xlt") 'Excel template of status report to
client
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("Files to Be
Reviewed") 'Name of sheet on template recordset is being transferred
to
objBook.Windows(1).Visible = True
Set rst = db.OpenRecordset("SELECT * FROM
QRY_RPT_TICKLER WHERE " & sCriteria, dbOpenSnapshot) 'dbOpenDynaset
dbOpenSnapshot) 'Opens the recordset and sets the variable
With objSheet
.Select
.Range("ExternalData").Clear 'Clears the current
data in the workbook range
.Range("A7").CopyFromRecordset rst 'rst Copies the
recordset into the worksheet
End With
rst.CLOSE
objApp.Visible = True
Dim objRange As Range
Set objRange = objSheet.Range("A7").CurrentRegion
With objRange
.Select
.Borders.Weight = xlThin
End With

Set rst = Nothing
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing
End Select


End Sub

 

[BruceM]

Allen Browne has a strategy for using a multi-select list box:
http://allenbrowne.com/ser-50.html

The Tips page at the web site, from which the above was taken, contains
quite an assortment of information:
http://allenbrowne.com/tips.html

 

[mscertified]

step thru the code with debug to see what is happening

-Dorian

 

[Damon Heron]

As far as I can see, there is no place where you load the multiple
selections from the listbox. Here is a function that you can call that will
load the selections and return them:

Public Function BuildWhereCondition(strControl As String) As String
'Set up the WhereCondition Argument for the reports
Dim varItem As Variant
Dim strWhereLst As String
Dim ctl As Control

Set ctl = Forms!frmAllReports!(strControl) ' this is my form name - use
your own name

Select Case ctl.ItemsSelected.Count
Case 0 'Include All
strWhereLst = ""
Case 1 'Only One Selected
strWhereLst = "= '" & _
ctl.ItemData(ctl.ItemsSelected(0)) & "'"
Case Else 'Multiple Selection
strWhereLst = " IN ("

With ctl
For Each varItem In .ItemsSelected
strWhereLst = strWhereLst & "'" & .ItemData(varItem) &
"', "
Next varItem
End With
strWhereLst = Left(strWhereLst, Len(strWhereLst) - 2) & ")"
End Select

BuildWhereCondition = strWhereLst

End Function

Call the function with a line like this:

strCatList = BuildWhereCondition("lstAll") ' strCatList is my variable name,
lstAll is my listbox -use your own names

HTH
Damon

I have developed a form for generating reports. Users have an option
to select criteria as well as the option to export to an excel
template or Access report. The problem I am having is that even
though "multi-select" is enabled for my list boxes, reports will only
generate when one selection is made. So, for instance, in the below
example, the filed "STATUS" is a multi-select list box, but only when
one status is selected will a report generate. Any assistance in
being able to enable a multi-select list box would be appreciated.

On Error Resume Next
Dim sCriteria As String
Dim db As Database
Dim rst As Recordset
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim Path As String

sCriteria = " 1 = 1 "

If STATUS <> "" Then
sCriteria = sCriteria & " AND QRY_RPT_TICKLER.STATUS =
""" & STATUS & """"
End If

If StartDate <> "" And EndDate <> "" Then
sCriteria = sCriteria & " AND QRY_RPT_TICKLER.
[DT_FILE_RVW] between #" & Format(StartDate, "dd-mmm-yyyy") & "# and
#" & Format(EndDate, "dd-mmm-yyyy") & "#"
End If

Dim stDocName As String
Select Case RPT_OPS
Case 1 'When the Access option is selected, loads the
Tickler Report
DoCmd.Minimize
DoCmd.OpenReport "RPT_TICKLER_MONTH", acViewPreview, ,
sCriteria

Case 2 'when the Excel option is selested, excel is opened
and the dataset populates the Excel template
Set db = CurrentDb()

Set objBook =
Workbooks.Add(template:=CurrentProject.Path &
"\VanCleef_File_Tickler.xlt") 'Excel template of status report to
client
Set objApp = objBook.Parent
Set objSheet = objBook.Worksheets("Files to Be
Reviewed") 'Name of sheet on template recordset is being transferred
to
objBook.Windows(1).Visible = True
Set rst = db.OpenRecordset("SELECT * FROM
QRY_RPT_TICKLER WHERE " & sCriteria, dbOpenSnapshot) 'dbOpenDynaset
dbOpenSnapshot) 'Opens the recordset and sets the variable
With objSheet
.Select
.Range("ExternalData").Clear 'Clears the current
data in the workbook range
.Range("A7").CopyFromRecordset rst 'rst Copies the
recordset into the worksheet
End With
rst.CLOSE
objApp.Visible = True
Dim objRange As Range
Set objRange = objSheet.Range("A7").CurrentRegion
With objRange
.Select
.Borders.Weight = xlThin
End With

Set rst = Nothing
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing
End Select


End Sub