gstreichan
Registered User.
- Local time
- Today, 10:44
- Joined
- Apr 1, 2014
- Messages
- 28
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?
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?