VBA insert & delete table rows within a table format+ Enable auto filter / sort with worksheet protection

[ShannonG]

Hi folks,

I'm not an expert for VBA and I would really need your help on correcting the macro codes for my work file.

1. What is needed:
- Certain columns have to be protected from editing.
- The rest of the file should be able to get edited ( insert row / delete row / auto filter / auto sort)

2. What has been achieved:
- The list has been formatted as a table.
- Columns are protected with deleting row function + filter, user can edit the rest of the file.
- Columns are protected with inserting row function, user can edit the rest of the file, but NOT filtering,

3. What problems need to be solved:
- To enable filtering function when inserting rows (with the validation of the existing
- To enable sorting function for both deleting rows and inserting rows commands.

I've spent several hours on trying to fix the problem but all failed , could you help me? Many thanks!!

Codes as below:

Insert Row:

Function IsCellInTable(cell As Range) As Boolean
'PURPOSE: Determine if a cell is within an Excel Table

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

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 Password As String
Dim area As Range

'Optimize Code
Application.ScreenUpdating = False

Password = "xxxxxx"

'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
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

'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)

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

Exit Sub

With ActiveSheet
.Protect Password:="xxxxxx", AllowFiltering:=True
.EnableSelection = xlUnlockedCells
End With

'ERROR HANDLERS
InvalidSelection:
MsgBox "You must select a cell within or directly below an Excel table"
If ReProtect = True Then ActiveSheet.Protect Password
Exit Sub

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

End Sub

Delete Row:

Sub DeleteMe()
Dim Ret As Range, Cl As Range

On Error Resume Next
Set Ret = Application.InputBox("Please select the Cells", "Delete Rows", Type:=8)
On Error GoTo 0

ActiveSheet.Unprotect Password:="xxxxxx"

If Not Ret Is Nothing Then Ret.EntireRow.Delete

ActiveSheet.Protect Password:="xxxxxx"

With ActiveSheet
.Protect Password:="CAPEX21", AllowFiltering:=True
.EnableSelection = xlUnlockedCells
End With

End Sub