VBA - Table Features Aren't Available Error - Despite Code Running

[MJaspering]

Hey All,

I am running into some oddities with the execution of the below. When I run the below based on the Worksheet_Change event, I get an error that states, "Table Features aren't available because the sheet is protected. This is odd as the code executes as intended but still throws the error. The debugger is pointing to the .ListRows.Add call in the second sub.

Any idea how I may be able to suppress this or prevent is from arising?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Worksheets("Retail Sales Funnel").Unprotect
    Worksheets("Archived Leads").Unprotect
    If Target.Column = 16 Then
        If Target.Value = "ARCHIVE" Then
            Call Move_Sales_Table_Rows
        End If
    End If
    Worksheets("Retail Sales Funnel").Protect
    Worksheets("Archived Leads").Protect
End Sub

Public Sub Move_Sales_Table_Rows()

    Dim salesTable As ListObject, archiveTable As ListObject
    Dim r As Long
    
    Set salesTable = ThisWorkbook.Worksheets("Retail Sales Funnel").ListObjects("ActiveLeads")
    Set archiveTable = ThisWorkbook.Worksheets("Archived Leads").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]

Hey All,

I am running into some oddities with the execution of the below. When I run the below based on the Worksheet_Change event, I get an error that states, "Table Features aren't available because the sheet is protected. This is odd as the code executes as intended but still throws the error. The debugger is pointing to the .ListRows.Add call in the second sub.

Any idea how I may be able to suppress this or prevent is from arising?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Worksheets("Retail Sales Funnel").Unprotect
    Worksheets("Archived Leads").Unprotect
    If Target.Column = 16 Then
        If Target.Value = "ARCHIVE" Then
            Call Move_Sales_Table_Rows
        End If
    End If
    Worksheets("Retail Sales Funnel").Protect
    Worksheets("Archived Leads").Protect
End Sub

Public Sub Move_Sales_Table_Rows()

    Dim salesTable As ListObject, archiveTable As ListObject
    Dim r As Long
   
    Set salesTable = ThisWorkbook.Worksheets("Retail Sales Funnel").ListObjects("ActiveLeads")
    Set archiveTable = ThisWorkbook.Worksheets("Archived Leads").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

NVM! Fixed with the below approach

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Target.Column = 16 Then
        If Target.Value = "ARCHIVE" Then
            Worksheets("Retail Sales Funnel").Unprotect
            Worksheets("Archived Leads").Unprotect
            Call Move_Sales_Table_Rows
            Worksheets("Retail Sales Funnel").Protect
            Worksheets("Archived Leads").Protect
        End If
    End If
    
End Sub