Search code examples
excelvbaoffice365

Move multiple rows from one table to another using conditional trigger

I built a workbook containing several tables, each table on their own sheet.
The purpose of the workbook is to assist with tracking patient lines.

When a new line is placed on a patient, a staff member will add that line to the table using a MS Forms/Power Automate flow.
At that time, the table column "status" would be marked as "Maintaining".
Additionally, the row would contain the patient's unique ID and current unit.

Should the patient transfer to a different unit, a new row would be added with updated information.
The original row "status" column would be changed to "transferred" but remain on the table for tracking purposes.
This process could continue through multiple transfers depending on the patient's stay and so would need to remain dynamic.

When the line is ready to be pulled, the "status" column would be marked as "Discontinued".
This should trigger VBA code to find all the rows with a matching Unique ID and move them all to an archived table and subsequently delete them from the active lines table.

In summary:
I'm looking to move multiple rows based on a shared "Unique ID" and for the flow to trigger when one of the rows containing that Unique ID "status" Column is changed to "Discontinued".

I built VBA code that will move one row based on the trigger.
I can't find a way to reference the unique ID of the row that is triggered to take all the matching rows containing the Unique ID with it.

For reference:
Active line table name: "CVL"
Active line sheet name: "CVL"

Archived line table name: "Archived_CVL"
Archived line sheet name: "Archived_CVL"

Status column name: "Status" Header location I3, Data Range: I4:I
Unique ID column name: "Unique ID" Header location A3, Data Range A4:A

Both the active table and the archived table have the same column headers and the same row/column locations. (Essentially the tables are a copy/paste of each other.)

Active CVL Sheet
1

Archived CVL Sheet
2

All information in the table is example data and not actual patient information.

Solution
    • Right click on sheet (CVL) tab > View Code > Paste code
    Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sID As String, oTab As ListObject, rngVis As Range
    Const KEYWORD = "Discontinued"
    Const UID = "Unique ID"
    Const DEST_SHT = "Archived_CVL"
    With Target
        If .CountLarge = 1 Then
            If .Column = 9 And .Row > 3 Then
                If (Not .ListObject Is Nothing) And StrComp(KEYWORD, .Value, vbTextCompare) = 0 Then
                    Set oTab = .ListObject
                    sID = Me.Cells(.Row, 1).Value
                    'Debug.Print sID
                    If oTab.AutoFilter.FilterMode Then oTab.AutoFilter.ShowAllData
                    oTab.Range.AutoFilter Field:=1, Criteria1:=sID
                    On Error Resume Next
                    Set rngVis = oTab.DataBodyRange.SpecialCells(xlCellTypeVisible)
                    On Error GoTo 0
                    If Not rngVis Is Nothing Then
                        With Sheets(DEST_SHT)
                            rngVis.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                        End With
                        Application.EnableEvents = False
                        oTab.AutoFilter.ShowAllData
                        rngVis.Delete
                        Application.EnableEvents = True
                    End If
                End If
            End If
        End If
    End With
End Sub