How to protect a header row while allowing deletion of inserted columns

Question

I have a worksheet and want to prevent the user from editing the header row cells but allow the user to insert and delete their own columns freely. When I try this, I am able to insert columns, but those columns become protected as well and are unable to be deleted.

With Worksheet1
    Dim lastHeaderColumn As Integer
    Dim headerColumnRange As Range
    
    .Unprotect ' Unprotecting entire worksheet
    
    lastHeaderColumn = .Cells(10, 1).End(xlToRight).Column ' Finding last column of table
    Set headerColumnRange = .Range(.Cells(10, 1), .Cells(10, lastHeaderColumn))

    headerColumnRange.Locked = True ' Setting all header cells to locked

    .Protect AllowInsertingColumns:=True, AllowDeletingColumns:=True ' Protecting header cells

End With

For the protect method, I set the parameters AllowInsertingColumns:=True and AllowDeletingColumns:=True. I am able to insert columns but still not able to delete.

Answer 1

With sheet protection, the option to allow deleting columns will only work if ALL cells in the selected column have been unlocked. If even one cell is locked, any attempt to delete the entire column will fail, because this action would be affecting a locked cell.

As a workaround, insert a command button on your worksheet and assign a macro to it for deleting columns. For example, you could use something like this:

Sub DeleteSelectedColumns()

    Dim rg As Range, ans As VbMsgBoxResult
    Set rg = Selection.EntireColumn

    'Prompt user for confirmation
    ans = MsgBox("Are you absolutely sure you want to delete column(s) " _
        & rg.Address(, False) & "?", vbExclamation + vbYesNoCancel)
    If ans <> vbYes Then Exit Sub

    'Delete the selected columns
    Worksheet1.Unprotect
    On Error Resume Next
    rg.Delete
    Worksheet1.Protect AllowInsertingColumns:=True
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbExclamation, "Run-time Error: " & Err.Number
    End If

End Sub