VBA integrating code to hide a column with existing code that allows cells table rows in protected sheet

[kcmuppet]

Hello,

I found some excellent code to add and delete table rows in protected sheets here: Insert & Delete Table Rows With Worksheet Protection — The Spreadsheet Guru, which @Fluff kindly helped me modify to enable filtering and sorting. The original code operates as 3 functions in a workbook module, but I also have code on my worksheet which hides a column unless there is specific text in another column below:

  ActiveSheet.Unprotect Password:="secret"
        Target.Calculate
        If Range("E" & (ActiveCell.Row)).Value <> "Test" Then
            Columns("G").EntireColumn.Hidden = True
        Else
            Columns("G").EntireColumn.Hidden = False
        End If
   ActiveSheet.Protect Password:="secret", AllowFiltering:=True, AllowSorting:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowDeletingColumns:=False

If this above code is enabled, the modules break with this message:

Run-time error '1004' Delete method of Range Class failed

...near the bottom of the DeleteTableRows module here:

'Delete row (if wanted)
  If Answer = vbYes Then DeleteRng.Delete xlShiftUp

It's way beyond my ability to debug and fix. Would somebody mind helping?

This is the full module code:

Function IsCellInTable(cell As Range) As Boolean
'PURPOSE: Determine if a cell is within an Excel Table
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

IsCellInTable = False

On Error Resume Next
  IsCellInTable = (cell.ListObject.Name <> "")
On Error GoTo 0

End Function

Sub AddTableRows()
'PURPOSE: Add table row based on user's selection
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim rng As Range
Dim InsertRows As Long
Dim StartRow As Long
Dim InsideTable As Boolean
Dim RowToBottom As Boolean
Dim ReProtect As Boolean
Dim Pword As String
Dim area As Range

'Optimize Code
  Application.ScreenUpdating = False

'What is the worksheet password?
  Pword = "secret"

'Set Range Variable
  On Error GoTo InvalidSelection
    Set rng = Selection
  On Error GoTo 0

'Unprotect Worksheet
  With ActiveSheet
    If .ProtectContents Or .ProtectDrawingObjects Or .ProtectScenarios Then
      On Error GoTo InvalidPassword
      .Unprotect Password:=Pword
      ReProtect = True
      On Error GoTo 0
    End If
  End With

'Loop Through each Area in Selection
  For Each area In rng.Areas

'    'Is selected Cell within a table?
'      InsideTable = IsCellInTable(area.Cells(1, 1))
'
'    'Is selected cell 1 row under a table?
'      RowToBottom = IsCellInTable(area.Cells(1, 1).Offset(-1))
'
'    'How Many Rows In Selection?
'      InsertRows = area.Rows.Count
'
'    'Selection Not Within Table?
'      If Not InsideTable And Not RowToBottom Then GoTo InvalidSelection
'
    'Is selected Cell within a table?
  
        InsideTable = IsCellInTable(area.Cells(1, 1))
      
        If InsideTable Then
      
        'Is selected Cell in the header row?
                If Not Intersect(rng.ListObject.HeaderRowRange, area.Cells(1, 1)) Is Nothing Then
                GoTo HeaderSelected
                End If
            End If
      
        'Is selected cell 1 row under a table?
            If area.Cells(1, 1).Row > 1 Then
                RowToBottom = IsCellInTable(area.Cells(1, 1).Offset(-1))
            End If
      
        'Selection Not Within Table?
            If Not InsideTable And Not RowToBottom Then GoTo InvalidSelection
      
        'How Many Rows In Selection?
            InsertRows = area.Rows.Count
   
  
    'Add Rows To Table
      If InsideTable Then
    
        'Which Row in Table is selected?
          With area.Cells(1, 1)
            x = .Row
            y = .ListObject.DataBodyRange.Row
            Z = .ListObject.DataBodyRange.Rows.Count
          End With
        
          StartRow = Z - ((y + Z - 1) - x)
        
        'Insert rows based on how many rows are currently selected
          For x = 1 To InsertRows
            area.ListObject.ListRows.Add (StartRow)
          Next x
      ElseIf RowToBottom Then
        For x = 1 To InsertRows
          area.Cells(1, 1).Offset(-1).ListObject.ListRows.Add AlwaysInsert:=True
        Next x
      End If

  Next area

'Protect Worksheet
  If ReProtect = True Then ActiveSheet.Protect Password:=Pword, AllowFiltering:=True, AllowSorting:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowDeletingColumns:=False

Exit Sub

'ERROR HANDLERS
InvalidSelection:
  MsgBox "You must select a cell within or directly below an Excel table"
  If ReProtect = True Then ActiveSheet.Protect Password:=Pword, AllowFiltering:=True, AllowSorting:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowDeletingColumns:=False
  Exit Sub

InvalidPassword:
  MsgBox "Failed to unlock password with the following password: " & Pword
  Exit Sub


HeaderSelected:
MsgBox "Can't add or delete while you're on an header."

If ReProtect = True Then ActiveSheet.Protect Password:=Pword, AllowFiltering:=True, AllowSorting:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowDeletingColumns:=False

Exit Sub


End Sub


Sub DeleteTableRows()
'PURPOSE: Delete table row based on user's selection
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim rng As Range
Dim DeleteRng As Range
Dim cell As Range
Dim TempRng As Range
Dim Answer As Variant
Dim Pword As String
Dim area As Range
Dim ReProtect As Boolean

'What is the worksheet password?
  Pword = "secret"

'Set Range Variable
  On Error GoTo InvalidSelection
    Set rng = Selection
  On Error GoTo 0

'Unprotect Worksheet
  With ActiveSheet
    If .ProtectContents Or ProtectDrawingObjects Or ProtectScenarios Then
      On Error GoTo InvalidPassword
      .Unprotect Password:=Pword
      ReProtect = True
      On Error GoTo 0
    End If
  End With

'Loop Through each Area in Selection
  For Each area In rng.Areas
    For Each cell In area.Cells.Columns(1)

      'Is selected Cell within a table?
        InsideTable = IsCellInTable(cell)
  
      'Gather rows to delete
        If InsideTable Then
          On Error GoTo InvalidActiveCell
          Set TempRng = Intersect(cell.EntireRow, ActiveCell.ListObject.DataBodyRange)
          On Error GoTo 0
        
          If DeleteRng Is Nothing Then
            Set DeleteRng = TempRng
          Else
            Set DeleteRng = Union(TempRng, DeleteRng)
          End If
  
        End If
      
    Next cell
  Next area

'Error Handling
  If DeleteRng Is Nothing Then GoTo InvalidSelection
  If DeleteRng.Address = ActiveCell.ListObject.DataBodyRange.Address Then GoTo DeleteAllRows
  If ActiveCell.ListObject.DataBodyRange.Rows.Count = 1 Then GoTo DeleteOnlyRow

'Ask User To confirm delete (since this cannot be undone)
    DeleteRng.Select
  
    If DeleteRng.Rows.Count = 1 And DeleteRng.Areas.Count = 1 Then
      Answer = MsgBox("Are you sure you want to delete the currently selected table row? " & _
       " This cannot be undone...", vbYesNo, "Delete Row?")
    Else
      Answer = MsgBox("Are you sure you want to delete the currently selected table rows? " & _
       " This cannot be undone...", vbYesNo, "Delete Rows?")
    End If
    
'Delete row (if wanted)
  If Answer = vbYes Then [COLOR=rgb(184, 49, 47)][U]DeleteRng.Delete xlShiftUp[/U][/COLOR]

'Protect Worksheet
  If ReProtect = True Then ActiveSheet.Protect Password:=Pword, AllowFiltering:=True, AllowSorting:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowDeletingColumns:=False

Exit Sub

'ERROR HANDLERS

InvalidActiveCell:
  MsgBox "The first cell you select must be inside an Excel Table. " & _
   "The first cell you selected was cell " & ActiveCell.Address, vbCritical, "Invalid Selection!"
  If ReProtect = True Then ActiveSheet.Protect Password:=Pword, AllowFiltering:=True, AllowSorting:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowDeletingColumns:=False
  Exit Sub

InvalidSelection:
  MsgBox "You must select a cell within an Excel table", vbCritical, "Invalid Selection!"
  If ReProtect = True Then ActiveSheet.Protect Password:=Pword, AllowFiltering:=True, AllowSorting:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowDeletingColumns:=False
  Exit Sub

DeleteAllRows:
  MsgBox "You cannot delete all the rows in the table. " & _
   "You must leave at least one row existing in a table", vbCritical, "Cannot Delete!"
  If ReProtect = True Then ActiveSheet.Protect Password:=Pword, AllowFiltering:=True, AllowSorting:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowDeletingColumns:=False
  Exit Sub

DeleteOnlyRow:
  MsgBox "You cannot delete the only row in the table.", vbCritical, "Cannot Delete!"
  If ReProtect = True Then ActiveSheet.Protect Password:=Pword, AllowFiltering:=True, AllowSorting:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowDeletingColumns:=False
  Exit Sub

InvalidPassword:
  MsgBox "Failed to unlock password with the following password: " & Pword
  Exit Sub

End Sub