Moving Table Row to Another Table Based on Condition

[MJaspering]

Hey All,

I am looking to move table rows from a table (SalesTable) on one tab "Sales" to another table (ArchiveTable) on another tab "Archive" based on the content of a the final cell. Ideally this would also create a new row in the SalesTable to ensure that the main table stays populated with blanks rows.

I would be looking to move the Sales table cells from range B:P to end of the Archive Table when the cell in Column P equals "ARCHIVE"

I found the code below which I am feeling a bit lost on how to customize this to my needs.

Option Explicit

Public Sub moveTableRows()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim tabStart As ListObject, tabProgress As ListObject, tabComp As ListObject
    Dim statusCol As Range
    Dim i As Long
    
    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet
    
    Set tabStart = ws.ListObjects("Started")
    Set tabProgress = ws.ListObjects("InProgress")
    Set tabComp = ws.ListObjects("Completed")
    Set statusCol = tabStart.ListColumns("status").DataBodyRange
    
    For i = tabStart.ListRows.Count To 1 Step -1
        If statusCol(i).Value = "In Progress" Then
            addTableRow tabStart.DataBodyRange.Rows(i).Value, tabProgress
            tabStart.ListRows(i).Delete
        ElseIf statusCol(i).Value = "Completed" Then
            addTableRow tabStart.DataBodyRange.Rows(i).Value, tabComp
            tabStart.ListRows(i).Delete
        End If
    Next i
    
End Sub

Public Sub addTableRow(sourceData As Variant, tabDest As ListObject)
    
    tabDest.ListRows.Add
    tabDest.DataBodyRange.Rows(tabDest.ListRows.Count).Value = sourceData

End Sub

 

[John_w]

I would be looking to move the Sales table cells from range B:P to end of the Archive Table when the cell in Column P equals "ARCHIVE"

With a table it doesn't matter which columns it occupies because the code can refer to a whole table row, regardless of the sheet column letters or row number.

The macro below looks at the last column in each Sales table row and moves the row to the bottom of the Archive table. It then deletes the Sales table row and adds a new blank row at the bottom.

Public Sub Move_Sales_Table_Rows()

    Dim salesTable As ListObject, archiveTable As ListObject
    Dim r As Long
    
    Set salesTable = ThisWorkbook.Worksheets("Sales").ListObjects("SalesTable")
    Set archiveTable = ThisWorkbook.Worksheets("Archive").ListObjects("ArchiveTable")
    
    With salesTable
        r = 1
        While r <= .DataBodyRange.Rows.Count
            If .DataBodyRange(r, .ListColumns.Count).Value = "ARCHIVE" Then
                'Add this SalesTable row to ArchiveTable
                AddTableRow archiveTable, .ListRows(r).Range.Value
                'Delete this SalesTable row and add a new row
                .ListRows(r).Delete
                AddTableRow salesTable
            Else
                r = r + 1
            End If
        Wend
    End With
    
End Sub


Private Sub AddTableRow(destTable As ListObject, Optional data As Variant)
    
    With destTable
        .ListRows.Add
        If Not IsMissing(data) Then
            .DataBodyRange.Rows(.ListRows.Count).Value = data
        End If
    End With
    
End Sub

 

[MJaspering]

With a table it doesn't matter which columns it occupies because the code can refer to a whole table row, regardless of the sheet column letters or row number.

The macro below looks at the last column in each Sales table row and moves the row to the bottom of the Archive table. It then deletes the Sales table row and adds a new blank row at the bottom.

Public Sub Move_Sales_Table_Rows()

    Dim salesTable As ListObject, archiveTable As ListObject
    Dim r As Long
   
    Set salesTable = ThisWorkbook.Worksheets("Sales").ListObjects("SalesTable")
    Set archiveTable = ThisWorkbook.Worksheets("Archive").ListObjects("ArchiveTable")
   
    With salesTable
        r = 1
        While r <= .DataBodyRange.Rows.Count
            If .DataBodyRange(r, .ListColumns.Count).Value = "ARCHIVE" Then
                'Add this SalesTable row to ArchiveTable
                AddTableRow archiveTable, .ListRows(r).Range.Value
                'Delete this SalesTable row and add a new row
                .ListRows(r).Delete
                AddTableRow salesTable
            Else
                r = r + 1
            End If
        Wend
    End With
   
End Sub


Private Sub AddTableRow(destTable As ListObject, Optional data As Variant)
   
    With destTable
        .ListRows.Add
        If Not IsMissing(data) Then
            .DataBodyRange.Rows(.ListRows.Count).Value = data
        End If
    End With
   
End Sub

@John_w - this was MAGIC. I cannot thank you enough. I was able to dig into the .DataBodyRange called here and pair that up with a Worksheet.Change event that calls the Sub to move the data between tables. EXACTLY what I was trying to accomplish. Thank you again!