Add from multiselect listbox items with multiple columns to another list box using cmd buttons

[Rfriend]

Does anyone know if you can move items in a multiselect list box each containing 5 columns to another list box? I have been successful moving one-column of my data between listboxes and removing with cmdbuttons but not multiple columns. What I am trying to do is run an advanced filter to return a list of students in ListBox1, and a list of training modules in Listbox2 with a single cmdbutton, but that is as far as I get. Listbox1 is a multiselect list box, ListBox2 is a single select list box. The completion date is a a text box (Trng9)

My problem is:
1. I need to be able to select multiple students in ListBox1 containing 5 columns, move all the selected students information to Listbox3.
2. I need to select one training module from my search results in ListBox2, which also contains 5 columns of data, and assign that class information to all the students selected and moved to ListBox3.
3. Then I need to also add a completion date via a txtBox (Trng9) to all students in ListBox3. My result is a list of students that completed a module of training on a certain date.
4. Finally, I need to add, through the use of a command button, the entire list of students in ListBox3, their training and completion date to the next available row in a worksheet (Data) which is a historic list of all completed training.

Can this type of move from two listboxes to a third consisting of 11 total columns be done?
I have looked at so many blogs and videos to try to find this and just don't see anything. If anyone can help or point me to a source I would be grateful.

Private Sub cmdMoveRight_Click()
    Dim iCtr As Long

    For iCtr = 0 To Me.Listbox1.ListCount - 1
        If Me.Listbox1.Selected(iCtr) = True Then
            Me.Listbox2.AddItem Me.Listbox1.List(iCtr)
 '       For iCtr = Me.Listbox1.ListCount - 1 To 0 Step -1
  '          If Me.Listbox1.Selected(iCtr) = True Then
   '             toListBox2.AddItem Me.Listbox1.List(i, 0)
'                toListBox1.List(toListBox1.ListCount - 1, 1) = toListBox2.List(i, 1)
        End If
    Next iCtr

    For iCtr = Me.Listbox1.ListCount - 1 To 0 Step -1
        If Me.Listbox1.Selected(iCtr) = True Then
            'Me.Listbox1.RemoveItem iCtr
        End If
    Next iCtr
End Sub

Private Sub cmdMoveLeft_Click()
    Dim iCtr As Long

    For iCtr = 0 To Me.Listbox2.ListCount - 1
        If Me.Listbox2.Selected(iCtr) = True Then
            'Me.Listbox1.AddItem Me.Listbox2.List(iCtr)
        End If
    Next iCtr

    For iCtr = Me.Listbox2.ListCount - 1 To 0 Step -1
        If Me.Listbox2.Selected(iCtr) = True Then
            Me.Listbox2.RemoveItem iCtr
        End If
    Next iCtr
End Sub

Private Sub cmdLoadTrng_Click()
    Dim addme As Range
    Dim x As Integer
    Set addme = Sheet2.Cells(Rows.Count, 32).End(xlUp).Offset(1, 0)
    For x = 0 To Me.Listbox1.ListCount - 1
        If Me.Listbox1.Selected(x) Then
            addme = Me.Listbox1.List(x)
            addme.Offset(0, 1) = Me.Listbox1.List(x, 1)
            addme.Offset(0, 2) = Me.Listbox1.List(x, 2)
            addme.Offset(0, 3) = Me.Listbox1.List(x, 3)
            addme.Offset(0, 4) = Me.Listbox1.List(x, 4)

            Set addme = addme.Offset(1, 0)
        End If
    Next x
    For x = 0 To Me.Listbox1.ListCount - 1
        If MeListbox1.Selected(x) Then Me.Listbox1.Selected(x) = False
    Next x
End Sub

 

[John_w]

To add items to a multiple column listbox you use AddItem to add a new row with just the first column item and then put the remaining column items in the new row's List array.

Private Sub cmdMoveRight_Click()
                
    Dim r As Long, c As Long
    Dim selectedRows As Collection
    
    Set selectedRows = New Collection
    
    With ListBox1
    
        'Move selected rows from ListBox1 to ListBox2
        
        For r = 0 To .ListCount - 1
            If .Selected(r) Then

                'Save row index for later deletion
            
                selectedRows.Add r
                
                'Add new row in ListBox2 with first column from ListBox1
                
                ListBox2.AddItem .List(r, 0), ListBox2.ListIndex
                
                'Put remaining column(s) in the new row
                
                For c = 1 To .ColumnCount - 1
                    ListBox2.List(ListBox2.ListCount - 1, c) = .List(r, c)
                Next

            End If
        Next
        
        'Delete selected rows from ListBox1
        
        For r = selectedRows.Count To 1 Step -1
            .RemoveItem selectedRows(r)
        Next
                
    End With

End Sub

 

[Rfriend]

Thank you for the response. This code moved all the first column over but only the data for the last record from listbox1 to listbox2. I need to move all the data for each student. In addition I need to update each student with the class taken in listbox3 and the date completed. In total there is 11 columns. 5 are from the student list, and the other 6 are a single class and date added to each of those students record shown itn Listbox2. Any ideas. I have been searching all day and pouring through videos with no luck.

 

[John_w]

There are several ways to populate a listbox. My ListBox1 and ListBox2 have these properties:

ColumnCount: 5
ColumnHeads: False
RowSource: blank

ListBox1 is populated from a fixed range using:

Private Sub UserForm_Initialize()
    Me.ListBox1.List = Worksheets("Sheet2").Range("A2:E20").Value
End Sub

Note that you can't remove an item (using RemoveItem) when RowSource is set to a range.

It's difficult to help you further without a sample workbook to see exactly how your listboxes are created and populated. Upload the workbook with dummy data to a file sharing site and post the link here.

 

[John_w]

Here is another approach which links each list box on the userform to a table, via the RowSource property:

ListBox1.RowSource = "Table1"
ListBox2.RowSource = "Table2"
ListBox3.RowSource = "Table3"

Using RowSource along with ColumnHeads = True means that the column headers are integral to the list boxes. The important properties of each list box are set by Userform_Initialize, so there is no need to set them in the userform designer.

All 3 tables are on Sheet2, which represents a 'database' to be displayed by the list boxes on the userform. Tables are used instead of simple ranges because it is easy to delete and add rows in a table without affecting other cells on the sheet.

The command button cmdMove_Click code moves (by copying and deleting) multiple selected rows from ListBox1 to ListBox3 and copies the single selected row from ListBox2 to the same row(s) in ListBox3 in adjacent columns starting at column 'ColR' and puts the date text box value in 'ColW'. Instead of using RemoveItem to delete the selected row(s) from ListBox1, which doesn't work because RowSource is defined (an error occurs), the code deletes the row(s) from Table1, thereby automatically deleting them from ListBox1.

Here is Sheet2 showing the 3 tables. Note that Table3 (black/grey) is an empty table, though an empty table must have 1 blank data row (M1:W2). The running user form is also shown with the 'A2' and 'A4' rows selected in ListBox1 and the 'G10' row selected in ListBox2. ListBox3 is empty, corresponding to the empty Table3. The user form also contains a Text box for the date and a Command button.

After clicking the Move button, the tables and list boxes look like this:

You will see that the 'A2' and 'A4' rows in ListBox1 have been moved to ListBox3 and deleted from Table1 and added to Table3. The 'G10' row has been copied from ListBox2 to 2 rows in ListBox3 starting at column 'ColR' and added to Table3 starting at column 'ColR'. The date has been copied to 'ColW' in ListBox3 and Table3.

Here is the userform code:

Private Sub UserForm_Initialize()
 
    Dim table3 As ListObject
 
    'Put any date in the text box
 
    Me.txtCompletionDate.Text = Date
 
    Set table3 = Worksheets("Sheet2").ListObjects("Table3")
 
    With Me.ListBox1
        .ColumnCount = 5
        .ColumnHeads = True
        .MultiSelect = fmMultiSelectMulti
        .TextAlign = fmTextAlignLeft
        .RowSource = "Table1"
        '.ColumnWidths = "15,40,52,177,40"
        .SetFocus
    End With

    With Me.ListBox2
        .ColumnCount = 5
        .ColumnHeads = True
        .MultiSelect = fmMultiSelectSingle
        .TextAlign = fmTextAlignLeft
        .RowSource = "Table2"
        '.ColumnWidths = "15,40,52,177,40"
    End With

    'Delete all data rows from Table3
 
    If Not table3.DataBodyRange Is Nothing Then table3.DataBodyRange.Delete
    
    With Me.ListBox3
        .ColumnCount = 11
        .ColumnHeads = True
        .TextAlign = fmTextAlignLeft
        .RowSource = "Table3"
        '.ColumnWidths = "15,40,52,177,40,87,177,177"
    End With

End Sub


Private Sub cmdMove_Click()
            
    Dim table1 As ListObject, table2 As ListObject, table3 As ListObject
    Dim ListBox1SelectedRows As Collection
    Dim ListBox2SelectedRow As Long
    Dim r As Long
    Dim table1Row As Range
    Dim table2Row As Range
    Dim table3Row As ListRow

    Set table1 = Worksheets("Sheet2").ListObjects("Table1")
    Set table2 = Worksheets("Sheet2").ListObjects("Table2")
    Set table3 = Worksheets("Sheet2").ListObjects("Table3")
 
    'Put selected rows in ListBox1 in a collection for copying and deleting
 
    Set ListBox1SelectedRows = New Collection
    With Me.ListBox1
        For r = 0 To Me.ListBox1.ListCount - 1
            If .Selected(r) Then ListBox1SelectedRows.Add r + 1
        Next
    End With

    With Me.ListBox2
        ListBox2SelectedRow = 0
        For r = 0 To .ListCount - 1
            If .Selected(r) Then ListBox2SelectedRow = r + 1
        Next
    End With
 
    If ListBox1SelectedRows.Count = 0 Or ListBox2SelectedRow = 0 Then
        MsgBox "You must select at least 1 row in ListBox1 and exactly 1 row in ListBox2"
        Exit Sub
    End If
 
    'Move selected row(s) in ListBox1 from Table1 to Table3, therefore deleting them from ListBox1 and adding them to ListBox3 and
    'and for each selected row in ListBox1, copy the selected row in ListBox2 from Table2 to adjacent columns in Table3
 
    For r = 1 To ListBox1SelectedRows.Count
 
        'Add row to Table3 and therefore to ListBox3
    
        Me.ListBox3.RowSource = ""
        If table3.DataBodyRange Is Nothing Then
            'Table3 has 1 data row which is empty
            Set table3Row = table3.ListRows.Add(1)
        Else
            Set table3Row = table3.ListRows.Add
        End If
        Me.ListBox3.RowSource = "Table3"

        'Copy selected row from Table1 to Table3
    
        Set table1Row = table1.ListRows(ListBox1SelectedRows(r)).Range
        table1Row.Copy table3Row.Range
    
        'Copy the single selected row (5 columns) in ListBox2 from Table2 to Table3 starting at the "ColR" column, and therefore to ListBox3
    
        Set table2Row = table2.ListRows(ListBox2SelectedRow).Range
        table2Row.Copy table3Row.Range(, table3.ListColumns("ColR").Index)
    
        'Put the completion date in the "ColW" column in Table3, and therefore in ListBox3
    
        table3Row.Range(, table3.ListColumns("ColW").Index).Value = CDate(txtCompletionDate.Value)
    
    Next
 
    'Delete selected rows from Table1 and therefore from ListBox1
 
    For r = ListBox1SelectedRows.Count To 1 Step -1
        table1.ListRows(ListBox1SelectedRows(r)).Delete
    Next
    
    'Scroll to bottom of ListBox3

    With ListBox3
        .TopIndex = .ListCount - 1
    End With

End Sub

 

[Rfriend]

Here is another approach which links each list box on the userform to a table, via the RowSource property:

ListBox1.RowSource = "Table1"
ListBox2.RowSource = "Table2"
ListBox3.RowSource = "Table3"

Using RowSource along with ColumnHeads = True means that the column headers are integral to the list boxes. The important properties of each list box are set by Userform_Initialize, so there is no need to set them in the userform designer.

All 3 tables are on Sheet2, which represents a 'database' to be displayed by the list boxes on the userform. Tables are used instead of simple ranges because it is easy to delete and add rows in a table without affecting other cells on the sheet.

The command button cmdMove_Click code moves (by copying and deleting) multiple selected rows from ListBox1 to ListBox3 and copies the single selected row from ListBox2 to the same row(s) in ListBox3 in adjacent columns starting at column 'ColR' and puts the date text box value in 'ColW'. Instead of using RemoveItem to delete the selected row(s) from ListBox1, which doesn't work because RowSource is defined (an error occurs), the code deletes the row(s) from Table1, thereby automatically deleting them from ListBox1.

Here is Sheet2 showing the 3 tables. Note that Table3 (black/grey) is an empty table, though an empty table must have 1 blank data row (M1:W2). The running user form is also shown with the 'A2' and 'A4' rows selected in ListBox1 and the 'G10' row selected in ListBox2. ListBox3 is empty, corresponding to the empty Table3. The user form also contains a Text box for the date and a Command button.

View attachment 64104

After clicking the Move button, the tables and list boxes look like this:

View attachment 64105

You will see that the 'A2' and 'A4' rows in ListBox1 have been moved to ListBox3 and deleted from Table1 and added to Table3. The 'G10' row has been copied from ListBox2 to 2 rows in ListBox3 starting at column 'ColR' and added to Table3 starting at column 'ColR'. The date has been copied to 'ColW' in ListBox3 and Table3.

Here is the userform code:

Private Sub UserForm_Initialize()
 
    Dim table3 As ListObject
 
    'Put any date in the text box
 
    Me.txtCompletionDate.Text = Date
 
    Set table3 = Worksheets("Sheet2").ListObjects("Table3")
 
    With Me.ListBox1
        .ColumnCount = 5
        .ColumnHeads = True
        .MultiSelect = fmMultiSelectMulti
        .TextAlign = fmTextAlignLeft
        .RowSource = "Table1"
        '.ColumnWidths = "15,40,52,177,40"
        .SetFocus
    End With

    With Me.ListBox2
        .ColumnCount = 5
        .ColumnHeads = True
        .MultiSelect = fmMultiSelectSingle
        .TextAlign = fmTextAlignLeft
        .RowSource = "Table2"
        '.ColumnWidths = "15,40,52,177,40"
    End With

    'Delete all data rows from Table3
 
    If Not table3.DataBodyRange Is Nothing Then table3.DataBodyRange.Delete
   
    With Me.ListBox3
        .ColumnCount = 11
        .ColumnHeads = True
        .TextAlign = fmTextAlignLeft
        .RowSource = "Table3"
        '.ColumnWidths = "15,40,52,177,40,87,177,177"
    End With

End Sub


Private Sub cmdMove_Click()
           
    Dim table1 As ListObject, table2 As ListObject, table3 As ListObject
    Dim ListBox1SelectedRows As Collection
    Dim ListBox2SelectedRow As Long
    Dim r As Long
    Dim table1Row As Range
    Dim table2Row As Range
    Dim table3Row As ListRow

    Set table1 = Worksheets("Sheet2").ListObjects("Table1")
    Set table2 = Worksheets("Sheet2").ListObjects("Table2")
    Set table3 = Worksheets("Sheet2").ListObjects("Table3")
 
    'Put selected rows in ListBox1 in a collection for copying and deleting
 
    Set ListBox1SelectedRows = New Collection
    With Me.ListBox1
        For r = 0 To Me.ListBox1.ListCount - 1
            If .Selected(r) Then ListBox1SelectedRows.Add r + 1
        Next
    End With

    With Me.ListBox2
        ListBox2SelectedRow = 0
        For r = 0 To .ListCount - 1
            If .Selected(r) Then ListBox2SelectedRow = r + 1
        Next
    End With
 
    If ListBox1SelectedRows.Count = 0 Or ListBox2SelectedRow = 0 Then
        MsgBox "You must select at least 1 row in ListBox1 and exactly 1 row in ListBox2"
        Exit Sub
    End If
 
    'Move selected row(s) in ListBox1 from Table1 to Table3, therefore deleting them from ListBox1 and adding them to ListBox3 and
    'and for each selected row in ListBox1, copy the selected row in ListBox2 from Table2 to adjacent columns in Table3
 
    For r = 1 To ListBox1SelectedRows.Count
 
        'Add row to Table3 and therefore to ListBox3
   
        Me.ListBox3.RowSource = ""
        If table3.DataBodyRange Is Nothing Then
            'Table3 has 1 data row which is empty
            Set table3Row = table3.ListRows.Add(1)
        Else
            Set table3Row = table3.ListRows.Add
        End If
        Me.ListBox3.RowSource = "Table3"

        'Copy selected row from Table1 to Table3
   
        Set table1Row = table1.ListRows(ListBox1SelectedRows(r)).Range
        table1Row.Copy table3Row.Range
   
        'Copy the single selected row (5 columns) in ListBox2 from Table2 to Table3 starting at the "ColR" column, and therefore to ListBox3
   
        Set table2Row = table2.ListRows(ListBox2SelectedRow).Range
        table2Row.Copy table3Row.Range(, table3.ListColumns("ColR").Index)
   
        'Put the completion date in the "ColW" column in Table3, and therefore in ListBox3
   
        table3Row.Range(, table3.ListColumns("ColW").Index).Value = CDate(txtCompletionDate.Value)
   
    Next
 
    'Delete selected rows from Table1 and therefore from ListBox1
 
    For r = ListBox1SelectedRows.Count To 1 Step -1
        table1.ListRows(ListBox1SelectedRows(r)).Delete
    Next
   
    'Scroll to bottom of ListBox3

    With ListBox3
        .TopIndex = .ListCount - 1
    End With

End Sub

John,

Thank you so much for this. I really appreciate the level and detail of your explanation and was not expecting all the work you put into this. I have been away so apologies for my delay in responding. This works exactly how I need it to. I will add to my database and create a dummy file to upload.

Question, does listbox1 have to delete the rows? Currently I have my form set to copy/paste the selected items in LB1 to LB3 without deleting, and I can select LB3 items to remove if needed. Once the list is complete I transfer the list to the history (archives) for users to search when determining is someone has had training already, it is time to retrain, or a record needs to be edited/updated.

Private Sub cmdMoveRight_Click()

    Dim IndexRow As Long
    Dim IndexCol As Long

    With Listbox1
        For IndexRow = 0 To .ListCount - 1
            If .Selected(IndexRow) = True Then
                Listbox3.AddItem .List(IndexRow, 0)
                For IndexCol = 1 To .ColumnCount - 1
                    Listbox3.List(Listbox3.ListCount - 1, IndexCol) = .List(IndexRow, IndexCol)
                Next
            End If
        Next
    End With

End Sub

 

[John_w]

Question, does listbox1 have to delete the rows?

No it doesn't - it deletes because you said you want to move the rows from LB1 to LB3. To not delete them remove this code:

    'Delete selected rows from Table1 and therefore from ListBox1
 
    For r = ListBox1SelectedRows.Count To 1 Step -1
        table1.ListRows(ListBox1SelectedRows(r)).Delete
    Next

With that removed the ListBox1SelectedRows collection isn't needed and the main For r = 1 To ListBox1SelectedRows.Count loop could be changed to reference ListBox1 directly.