lRecord is a Long data type. I am using that to take what I am assuming is the Primary Key for your records, which I am assuming is an Integer (autonumber). That is the field I called "SampleID" in my table. If you post your table structure, and the field names on your form, then I can mod the code.

As to the print code, your original post seemed to indicate you already had the code to print the items selected in the list box somehow ("Now i want the printed records to be flagged in table..."). So I assumed you already had that code. Do you need code to print the selections as well?


mmcdonal

Look it up at: http://wrox.books24x7.com

I have given my code below.I have two listbox both are text field.But now i want to change one listbox which has Autonumber field(Any code to be changed for autonumber?).Can you now modify the code for me.


Private Sub filter_Click()

Dim varItem As Variant
Dim strwhere As String
Dim strreport As String
''Initialise the filter
strwhere = ""
strreport = "reportname"
''The first listbox
If lstbox1.ItemsSelected.Count > 0 Then
    strwhere = strwhere & "("
    For Each varItem In lstbox1.ItemsSelected
    strwhere = strwhere & "Tabllename.Fieldname =" _
    & Chr(39) & Me![lstbox1].Column(0, varItem) & Chr(39) & " Or "

    Next varItem

    strwhere = Left(strwhere, Len(strwhere) - 4) 'Remove the last " Or "
      strwhere = strwhere & ")"
End If

If Len(strwhere) > 0 Then strwhere = strwhere & " And "

''For subsequent list boxes, duplicate the code above and change to suit the fields
If lstbox2.ItemsSelected.Count > 0 Then
    strwhere = strwhere & "("
    For Each varItem In lstbox2.ItemsSelected
    strwhere = strwhere & "Tablename.Fieldname =" _
    & Chr(39) & Me![lstbox2].Column(0, varItem) & Chr(39) & " Or "

    Next varItem

    strwhere = Left(strwhere, Len(strwhere) - 4) 'Remove the last " Or "
      strwhere = strwhere & ")"
End If
    If Len(strwhere) > 0 Then strwhere = strwhere

''Then put it all together and run the filter

 DoCmd.OpenReport strreport, acViewReport, , strwhere
End Sub

The code I wrote was written to use an autonumber field as the bound column. Just put it after this code, but before the DoCmd.Open Report line, with the name changes as needed. Make sure to add the Yes/No field to your tables.

mmcdonal

Look it up at: http://wrox.books24x7.com

I modified the code with your code.But when i click filter button it gives me an error

Run-time error '6':

overflow

Am i making mistake in my code anywhere?Do i need to change Chr(39) to Integer or something for Autonumber listbox? can u solve it.

Private Sub filter_Click()

Dim varItem As Variant
Dim strwhere As String
Dim strreport As String
''Initialise the filter
strwhere = ""
strreport = "reportname"
''The first listbox
If lstbox1.ItemsSelected.Count > 0 Then
    strwhere = strwhere & "("
    For Each varItem In lstbox1.ItemsSelected
    strwhere = strwhere & "Tabllename.Fieldname =" _
    & Chr(39) & Me![lstbox1].Column(0, varItem) & Chr(39) & " Or "

    Next varItem

    strwhere = Left(strwhere, Len(strwhere) - 4) 'Remove the last " Or "
      strwhere = strwhere & ")"
End If

If Len(strwhere) > 0 Then strwhere = strwhere & " And "

''For subsequent list boxes, duplicate the code above and change to suit the fields
If lstbox2.ItemsSelected.Count > 0 Then
    strwhere = strwhere & "("
    For Each varItem In lstbox2.ItemsSelected
    strwhere = strwhere & "Tablename.Fieldname =" _
    & Chr(39) & Me![lstbox2].Column(0, varItem) & Chr(39) & " Or "

    Next varItem

    strwhere = Left(strwhere, Len(strwhere) - 4) 'Remove the last " Or "
      strwhere = strwhere & ")"
End If
    If Len(strwhere) > 0 Then strwhere = strwhere

''Then put it all together and run the filter
Dim rs As ADODB.Recordset
Dim sSQL As String
Dim lRecord As Long
Dim ctrl As Control
Dim intCurrentRow As Integer

Set ctrl = Me.lstsrl

For intCurrentRow = 0 To ctrl.ListCount - 1

    If ctrl.Selected(intCurrentRow) Then
        lRecord = ctrl.Column(0, intCurrentRow)
        sSQL = "UPDATE Table5 SET [Check] = Yes WHERE [Autonumberfield] = " & lRecord
        Set rs = New ADODB.Recordset
        rs.Open sSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
    End If
Next intCurrentRow

'Do Print actions here

Me.lstsrl.Requery

 DoCmd.OpenReport strreport, acViewReport, , strwhere
End Sub

You didn't change the code to point to the table behind Me.lstsrl.

You need to do this to start: Change Table5 to the actual table name, and change Autonumberfield to the actual PK field name.


sSQL = "UPDATE Table5 SET [Check] = Yes WHERE [Autonumberfield] = " & lRecord

I am not sure whether your other code works or not. Did you test it before adding this code?

Also, I see you have no method for opening a report or form based on the criteria string you are building.

mmcdonal

Look it up at: http://wrox.books24x7.com

I tested my code before adding your your code and it was working fine. I have also changed the table name and fieldname for autonumber.

The code i was using allowed me to select multiple options from both the listbox and opens report the selected options.

What is the code that you have now? Can you post that?


mmcdonal

Look it up at: http://wrox.books24x7.com

I have two multiselect listbox

Listbox1 = lstsl (text)
Listbox2 = lstsrl (Autonumber) Earlier was using text.
Reportname = Product1
Tablename = Product
Field = Print(where flag to be updated)
Serial No = Autonumber Field

 When i was using both listbox as text it was working.But now i want one listbox to be changed to Autonumber. So i think the code here Chr(39) indicates "Character". Should i change that to something to mention it as Autonumber ?

The Code is :

Private Sub filter_Click()

Dim varItem As Variant
Dim strwhere As String
Dim strreport As String
''Initialise the filter
strwhere = ""
strreport = "Product1"
''The first listbox
If lstsl.ItemsSelected.Count > 0 Then
    strwhere = strwhere & "("
    For Each varItem In lstsl.ItemsSelected
    strwhere = strwhere & "master.city =" _
    & Chr(39) & Me![lstsl].Column(0, varItem) & Chr(39) & " Or "

    Next varItem

    strwhere = Left(strwhere, Len(strwhere) - 4) 'Remove the last " Or "
      strwhere = strwhere & ")"
End If

If Len(strwhere) > 0 Then strwhere = strwhere & " And "

''For subsequent list boxes, duplicate the code above and change to suit the fields
If lstprdt.ItemsSelected.Count > 0 Then
    strwhere = strwhere & "("
    For Each varItem In lstprdt.ItemsSelected
    strwhere = strwhere & "Master.Product =" _
    & Chr(39) & Me![lstprdt].Column(0, varItem) & Chr(39) & " Or "

    Next varItem

    strwhere = Left(strwhere, Len(strwhere) - 4) 'Remove the last " Or "
      strwhere = strwhere & ")"
End If
    If Len(strwhere) > 0 Then strwhere = strwhere

''Then put it all together and run the filter
'DoCmd.OpenReport "Product1"
'DoCmd.ApplyFilter , strWhere

'YOUR CODE

Dim rs As ADODB.Recordset
Dim sSQL As String
Dim lRecord As Long
Dim ctrl As Control
Dim intCurrentRow As Integer

Set ctrl = Me.lstsrl

For intCurrentRow = 0 To ctrl.ListCount - 1

    If ctrl.Selected(intCurrentRow) Then
        lRecord = ctrl.Column(0, intCurrentRow)
        sSQL = "UPDATE Product SET [Print] = Yes WHERE [Serial No] = " & lRecord
        Set rs = New ADODB.Recordset
        rs.Open sSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
    End If
Next intCurrentRow

'Do Print actions here

Me.lstsrl.Requery


DoCmd.OpenReport strreport, acViewReport, , strwhere
End Sub

Okay, I cleaned this up a bit:

Private Sub filter_Click()

Dim varItem As Variant
Dim strwhere As String
Dim strreport As String
Dim rs As ADODB.Recordset
Dim sSQL As String
Dim lRecord As Long
Dim sRecord As String
Dim ctrl As Control
Dim intCurrentRow As Integer

strwhere = ""
strreport = "Product1"

'Using Text as Column(0)
If lstsl.ItemsSelected.Count > 0 Then
    strwhere = strwhere & "("
        For Each varItem In lstsl.ItemsSelected
            strwhere = strwhere & "master.city = '" _
            & Me![lstsl].Column(0, varItem) & "' Or "
        Next varItem
        strwhere = Left(strwhere, Len(strwhere) - 4)
          strwhere = strwhere & ")"
End If

If Len(strwhere) > 0 Then strwhere = strwhere & " And "

'Using integer PK as Column(0)
If lstprdt.ItemsSelected.Count > 0 Then
    strwhere = strwhere & "("
        For Each varItem In lstprdt.ItemsSelected
            strwhere = strwhere & "Master.Product =" & Me![lstprdt].Column(0, varItem) & " Or "
        Next varItem
        strwhere = Left(strwhere, Len(strwhere) - 4)
          strwhere = strwhere & ")"
End If

If Len(strwhere) > 0 Then strwhere = strwhere

'For Text
Set ctrl = Me.lstsl
For intCurrentRow = 0 To ctrl.ListCount - 1
    If ctrl.Selected(intCurrentRow) Then
        sRecord = ctrl.Column(0, intCurrentRow)
        sSQL = "UPDATE Product SET [Print] = Yes WHERE [city] = " & sRecord
        Set rs = New ADODB.Recordset
        rs.Open sSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
    End If
Next intCurrentRow
intCurrentRow = 0

'For Text
Set ctrl = Me.lstsrl
For intCurrentRow = 0 To ctrl.ListCount - 1
    If ctrl.Selected(intCurrentRow) Then
        lRecord = ctrl.Column(0, intCurrentRow)
        sSQL = "UPDATE Product SET [Print] = Yes WHERE [Serial No] = " & lRecord
        Set rs = New ADODB.Recordset
        rs.Open sSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
    End If
Next intCurrentRow

Me.lstsl.Requery
Me.lstsrl.Requery

DoCmd.OpenReport strreport, acViewReport, , strwhere
End Sub

Is that working?

mmcdonal

Look it up at: http://wrox.books24x7.com

Its Gives me an error saying:

Run-time error '424':

Object Required