Question Pass 3 MultiSelect ListBox Columns to a Subform (1 Viewer)

gstreichan

Registered User.
Local time
Today, 11:09
Joined
Apr 1, 2014
Messages
26
Dears, I have looked for a thread on this subject but can't find, I am hoping someone can help me. This is the scenario:

Form1- Main Form
Form2 - Subform with TextBoxes: Name, Surname, Birthday
Multi Select ListBox (List22) - It is a summary showing all people with 3 columns: Name, Surname, Birthday
Button14

What I want is to select multiple names on ListBox then click on the button and the names, surnames, birthdays selected will be filled up in Form2. I have a VBA code but it is not working properly, it passes the names properly to Form2 (first column) but the columns Surname (2nd column) and Birthday (3rd column) somehow repeats and is not transferred according to the name. For instance:

ListBox > GABRIEL | SANTOS | 13-July-1982
MICKAEL | HUMMER | 20-Aug-2009
ANGELO | WINSTON | 15-Dec-2009

I select these 3 rows in the list box and when I press the button to pass these 3 rows and columns to Form2, it ends up like:

Form2 > GABRIEL | SANTOS | 13-July-1982
MICKAEL | SANTOS | 13-July-1982
ANGELO | SANTOS | 13-July-1982

The VBA I am using is:

Private Sub Command38_Click()
Dim strSql As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim ctl As Control
Dim varitem As Variant

On Error GoTo ErrorHandler

Set db = CurrentDb()
Set rs = db.OpenRecordset("Form2", dbOpenDynaset, dbAppendOnly)

'make sure a selection has been made
If Me.List22.ItemsSelected.Count = 0 Then
MsgBox "You must select at least 1 Name", vbOKOnly, "No Name Selected"
Exit Sub
End If

If Not IsNumeric(Me.[DB-Report_Nr]) Then
MsgBox "You must fill out the Header first."
Exit Sub
End If

'add selected value(s) to table
Set ctl = Me.List22
For Each varitem In ctl.ItemsSelected
rs.AddNew
rs![Name] = ctl.ItemData(varitem)
rs![Surname] = List22.Column(1)
rs![Birthday] = List22.Column(2)
rs.Update
Next varitem
Form2.Requery
Me.List22.RowSource = Me.List22.RowSource
Me.List22.Requery

ExitHandler:
Set rs = Nothing
Set db = Nothing
Exit Sub

ErrorHandler:
Select Case Err
Case Else
MsgBox "You must fill out the header first and create a new number."
DoCmd.Hourglass False
Resume ExitHandler
End Select

End Sub

Please help me, what am I missing?
 

Ranman256

Well-known member
Local time
Today, 06:09
Joined
Apr 9, 2015
Messages
4,337
Don't use multi select list, instead use a dbl-click .
This runs an append query to add it to the sub-table.
No code needed.
 

gstreichan

Registered User.
Local time
Today, 11:09
Joined
Apr 1, 2014
Messages
26
There are hundreds of names and to double click on each one will be a huge work.... does it mean it is not possible?
 

June7

AWF VIP
Local time
Today, 02:09
Joined
Mar 9, 2014
Messages
5,423
ctl variable isn't really needed.
Code:
With Me.List22
    For Each varItem In .ItemsSelected
        rs.AddNew
        rs![Name] = .Column(0, varItem)
        rs![Surname] = .Column(1, varItem)
        rs![Birthday] = .Column(2, varItem)
        rs.Update
    Next varItem
End With
For future, please post lengthy code between CODE tags to retain indentation and readability.

Why do you need to copy this data? Why not just save person's ID?

You aren't really passing data to form, you are saving to a table that is form's recordsource.
 
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 18:09
Joined
May 7, 2009
Messages
19,169
Code:
Private Sub Button14_Click()
Dim v As Variant
If Me.List22.ItemsSelected.Count > 0
    With Me!Form2.RecordsetClone
        For Each v In Me.list2.ItemsSelected
            .AddNew
            !Name = Me.List22.Column(0, v)
            !Surname = Me.List22.Column(1, v)
            !Birthday = Me.List22.Column(2, 0)
            .Update
         Next
         Me.Bookmark = .LastModified
    End With
End If
End Sub
 

Users who are viewing this thread

Top Bottom