Copy from one table to the end of another using structured references

[sspatriots]

Good morning,

Not sure where I've gone wrong with the code below that uses structured table references. I'm trying to piece this together from another code that I already have that used to copy information from a worksheet table directly to a Userform. I'm trying to modify this code to copy 3 cells in a worksheet table row from a table called "Parts_Orders" on the similarly named worksheet called "Parts Orders" (via row selection using an "Application.InputBox" to select a cell in the second or third column of a particular row) and add it to the last row of a table called "COMM_In_Production" on another worksheet with the similar name of the table called "COMM - In Production". Any help with digging myself out of this one would be greatly appreciated. Thank you, SS

Sub AddItemToCOMMPRODSCHED()

   Dim WB As Workbook
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   Dim tb1 As ListObject
   Dim tb2 As ListObject
   Dim r As Long
   Dim lr As Long
   Dim c As Long

   Set WB = ThisWorkbook

   Set Ws1 = WB.Sheets("Parts Orders") 'Worksheet the Source Table is on
   Set Ws2 = WB.Sheets("COMM - In Production") 'Worksheet the Destination Table is on

   Set tb1 = Ws1.ListObjects("Parts_Orders") 'Source Table
   Set tb2 = Ws2.ListObjects("COMM_In_Production")  'Destination Table


On Error Resume Next
Set myRange = Application.InputBox(Prompt:="Please click on the Estimate # or Part Description/(Job Name) you want to move to the 'COMM - In Production' Job List", _
Title:="Select Row", Type:=8)

r = myRange.Row
c = myRange.Column
If myRange Is Nothing Then Exit Sub

S_name = Cells(r, "C")
F_name = Cells(r, "B")
MSG1 = MsgBox("Move Estimate #: " & F_name & ", Part Description: " & S_name, vbYesNo)
If MSG1 = vbNo Then Exit Sub

lr = Ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
  
   With tb2

      For r = 1 To tb1.DataBodyRange.Rows.Count

         If tb1.ListColumns("Estimate #").DataBodyRange.Cells(r).Value = tb2.ListColumns("Job #").DataBodyRange.Cells(lr).Value Then


            .ListColumns("Job #").DataBodyRange.Cells(lr).Value = tb1.ListColumns("Estimate #").DataBodyRange.Cells(r).Value
            .ListColumns("Job Name").DataBodyRange.Cells(lr).Value = tb1.ListColumns("Part Description/Job Name (If APPL)").DataBodyRange.Cells(r).Value
            .ListColumns("Folder Due Date").DataBodyRange.Cells(lr).Value = tb1.ListColumns("Due Date").DataBodyRange.Cells(r).Value


            Exit For

         End If

      Next

   End With

End Sub

 

[John_w]

Try this:

Sub AddItemToCOMMPRODSCHED()

    Dim PartsTable As ListObject, COMMTable As ListObject
    Dim SelectedPart As Range
    Dim PartRow As Range
    Dim NewCOMMRow As ListRow

    Set PartsTable = ThisWorkbook.Worksheets("Parts Orders").ListObjects("Parts_Orders") 'Source Table
    Set COMMTable = ThisWorkbook.Worksheets("COMM - In Production").ListObjects("COMM_In_Production")  'Destination Table

    On Error Resume Next
    Set SelectedPart = Application.InputBox(Prompt:="Please click on the Estimate # or Part Description/(Job Name) you want to move to the 'COMM - In Production' Job List", _
        Title:="Select Row", Type:=8)
    On Error GoTo 0
    If SelectedPart Is Nothing Then Exit Sub
        
    If SelectedPart.Row >= PartsTable.DataBodyRange.Row And SelectedPart.Row <= PartsTable.DataBodyRange.Row + PartsTable.DataBodyRange.Rows.Count - 1 Then    
        Set PartRow = PartsTable.ListRows(SelectedPart.Row - PartsTable.DataBodyRange.Row + 1).Range
        If MsgBox("Move Estimate #: " & PartRow(, "B").Value & ", Part Description: " & PartRow(, "C").Value, vbYesNo) = vbYes Then
            Set NewCOMMRow = COMMTable.ListRows.Add
            PartRow.Copy NewCOMMRow.Range
        End If        
    Else    
        MsgBox "Not copied - selected cell is outside Parts_Orders table data", vbExclamation    
    End If

End Sub

 

[sspatriots]

Thanks for preparing and sharing this. Is it possible to just copy 3 values from the selected row and to the destination table that has different column headings? That is what I was trying to accomplish with the part of the code I had below. However, no matter what I did with that part of my code it came back as nothing.

The values that I'm trying to copy are columns B, C & S in my source table and columns A, B & Q in my destination table.

            tb2.ListColumns("Job #").DataBodyRange.Cells(lr).Value = tb1.ListColumns("Estimate #").DataBodyRange.Cells(r).Value
            tb2.ListColumns("Job Name").DataBodyRange.Cells(lr).Value = tb1.ListColumns("Part Description/Job Name (If APPL)").DataBodyRange.Cells(r).Value
            tb2.ListColumns("Folder Due Date").DataBodyRange.Cells(lr).Value = tb1.ListColumns("Due Date").DataBodyRange.Cells(r).Value

 

[John_w]

How about this:

Public Sub AddItemToCOMMPRODSCHED2()

    Dim PartsTable As ListObject, COMMTable As ListObject
    Dim SelectedPart As Range
    Dim NewCOMMRow As ListRow
    Dim r As Long

    Set PartsTable = ThisWorkbook.Worksheets("Parts Orders").ListObjects("Parts_Orders") 'Source Table
    Set COMMTable = ThisWorkbook.Worksheets("COMM - In Production").ListObjects("COMM_In_Production")  'Destination Table

    On Error Resume Next
    Set SelectedPart = Application.InputBox(Prompt:="Please click on the Estimate # or Part Description/(Job Name) you want to move to the 'COMM - In Production' Job List", _
        Title:="Select Row", Type:=8)
    On Error GoTo 0
    If SelectedPart Is Nothing Then Exit Sub
    
    r = SelectedPart.Row - PartsTable.DataBodyRange.Row + 1
    
    If SelectedPart.Row >= PartsTable.DataBodyRange.Row And r <= PartsTable.DataBodyRange.Rows.Count Then        
        If MsgBox("Move Estimate #: " & PartsTable.DataBodyRange(r, PartsTable.ListColumns("Estimate #").Index).Value & _
                  ", Part Description: " & PartsTable.DataBodyRange(r, PartsTable.ListColumns("Part Description/Job Name (If APPL)").Index).Value, vbYesNo) = vbYes Then
            Set NewCOMMRow = COMMTable.ListRows.Add
            With COMMTable
                .DataBodyRange(NewCOMMRow.Index, .ListColumns("Job #").Index).Value = PartsTable.DataBodyRange(r, PartsTable.ListColumns("Estimate #").Index).Value
                .DataBodyRange(NewCOMMRow.Index, .ListColumns("Job Name").Index).Value = PartsTable.DataBodyRange(r, PartsTable.ListColumns("Part Description/Job Name (If APPL)").Index).Value
                .DataBodyRange(NewCOMMRow.Index, .ListColumns("Folder Due Date").Index).Value = PartsTable.DataBodyRange(r, PartsTable.ListColumns("Due Date").Index).Value
            End With
        End If        
    Else    
        MsgBox "Not copied - selected cell is outside Parts_Orders table data", vbExclamation    
    End If

End Sub

 

[sspatriots]

Perfect. Thank you so much. What I was trying to do was much longer than what you have here and I couldn't even get there with what I had.