Future Proof Code for new Column entry

Hi All

I have some code that is currently working for me as an archive function. If values in a cell contain certain criteria it copies the whole row to another sheet and deletes. However, issue I am facing is that if I add a new column into the sheet, I have to up version the code each time. Is there a clean way of future proofing the code so that it works to find the criteria based on the column name in a table??

The sheet I am writing the code for has a table called Main Table and there are two columbs one called 'Live' and one called BCR Demand Status

Essentially I'd like to be able to insert a new column and instead of the code looking for the value column 26, it will alway look for the values in Column BCR demand status within the table.

Thanks

Sub CutCopy()
If MsgBox("Are you sure you want to move Live or Rejected demand to Archive", vbYesNo + Question) = vbYes Then
Worksheets("Demand Capture").Unprotect
Worksheets("Archive").Unprotect
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long, i As Long, j As Long
Set ws1 = Sheets("Demand Capture")
Set ws2 = Sheets("Archive")
lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lastrow
    If ws1.Cells(i, 1).Value = "Y" Or ws1.Cells(i, 26).Value = "Rejected" Then
        ws1.Rows(i).Copy
        j = 2
        Do Until IsEmpty(ws2.Cells(j, 1))
            j = j + 1
        Loop
        ws2.Cells(j, 1).PasteSpecial (xlPasteAll)
        ws1.Rows(i).EntireRow.Delete
        i = i - 1
        lastrow = lastrow - 1
    End If
    Next i
    Worksheets("Demand Capture").Protect Contents:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, DrawingObjects:=True
    Worksheets("Archive").Protect Contents:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, DrawingObjects:=True
    Worksheets("Demand Capture").Activate
    ActiveWindow.Zoom = 85
    MsgBox "Archive Complete"
    Else
Exit Sub
End If
End Sub