Mass Assign Training and Combine from Different Tables Using VBA

[Rfriend]

Hello,

I am trying to change my consolidated list boxes and not sure how to do it. Right now I have 2 listboxs using data from 2 different tables that consolidate to a third table and listbox. Once combined and the user is happy they move the data to a 4th table database of historical training. Below is the code I have and I am trying to change it a bit, but that is above my skill set. I am really hoping someone can help me to adapt this as described below.

Currently:
1. Userform performs a "mass complete" assigning many students in table1/listbox1 to one training event in table2listbox2 and combined the data in table3/listbox3
2. Before combining to table3 a completion date and hours of training is input and added to the training record for each student in the current selection.
3. Once the command button is clicked to combine all the data, the data is sent to the next empty row in table4/sheet8

I want to perform the same action as above, sort of, except I want to select many students and assign them to many training at one time. For example, I have 10 people that need to review the same 15 SOP's = 150 records. I want to assign the training (rather than complete training like above) and move the combined data to table5 where it will live until the training is completed. Then I will go to table5 and complete the training, add the hours for each SOP and, using the method above, move the completed training to table4. Because this is a list of annual training and the only training we assign and track it all lives on a different page until completed.

My Current Code

Private Sub cmdArchive_Click()
' Sends the training to table4 once completed.

    Sheets("Sheet2").Select
        Range("L7").Select
            Range("Table3").Select
                Selection.Copy
                    Sheets("Data").Select
                Range("B2").Select
            ActiveCell.Offset(1, 0).Range("A1").Select
        Selection.End(xlDown).Select
    ActiveSheet.Paste
        MsgBox "Your training records have been added."
    Clear
    Interface
End Sub

Private Sub cmdMove_Click()
     'Combines the data from table 1, 2, hours of training, and completions date to table3
    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 training to assign and students to assign to"
        Exit Sub
    End If
 
    'Copy selected row(s) in ListBox1 from Table1 to Table3, 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"

        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
 
  'Scroll to bottom of ListBox3

    With ListBox3
        .TopIndex = .ListCount - 1
    End With

End Sub