Prevent deletion of last row of excel table

[Eric Carolus]

Hi folks

I have an Excel Table with names and abbreviations of names (two columns only).
I would like to prevent users from deleting the header row and last row in the table.[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Abbreviation[/TD]
[TD]Surname and Initial[/TD]
[/TR]
[TR]
[TD]PM[/TD]
[TD]Masters, P[/TD]
[/TR]
[TR]
[TD]JL[/TD]
[TD]Leonard, J[/TD]
[/TR]
[TR]
[TD]JM[/TD]
[TD]Matsau, J[/TD]
[/TR]
[TR]
[TD]TOTAL[/TD]
[TD]3 [given by Subtotal(3;"Dynamic Range")[/TD]
[/TR]
</tbody>[/TABLE]
However, users should be able to INSERT & DELETE anywhere in the table.

Please help. Thanks in advance.

Crow

 

[John_w]

A possible solution is to lock the table's Header row and Total row and protect the sheet but allow users to insert and delete rows.

This macro does this on the first table in the active sheet, with the optional password "secret":

Public Sub Lock_Table_Header_and_Total_Rows()

    Dim table As ListObject
    
    With ActiveSheet
        .Cells.Locked = False
        Set table = .ListObjects(1)
        table.HeaderRowRange.Locked = True
        table.TotalsRowRange.Locked = True
        .Protect Password:="secret", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
    End With
    
End Sub

Run this macro if you need to unlock the rows and reset the sheet protection to Excel's default (all cells on sheet locked and sheet unprotected):

Public Sub Unlock_Table_Header_and_Total_Rows()

    Dim table As ListObject
    
    With ActiveSheet
        .Unprotect Password:="secret"
        Set table = .ListObjects(1)
        table.HeaderRowRange.Locked = False
        table.TotalsRowRange.Locked = False
        .Cells.Locked = True
    End With
    
End Sub

 

[Eric Carolus]

Hi John_w

Thanks you for your speedy reply.
The Public Sub Lock_Table_Header_and_Total_Rows() works well, meaning that the Header row is locked, I can Insert and
Delete rows BUT the Totals row can still be deleted.

Any other ideas?
I would really appreciate it.
Thanks Again.

Crow

 

[John_w]

I'm unable to reproduce the problem - for me, the table's Total Row can't be deleted. Remember, the code is referencing the first table on the active sheet.

Do any errors occur? If so, what is the complete error message?

Is the totals row a proper Table Total Row, or simply the last row in the table which you have put a formula in? If the latter, then an error would occur because the code references TotalsRowRange.

 

[Eric Carolus]

Hi John_w

I am sorry to be a nuisance but I still could not make the table work
Out of sheer frustration I am including the workbook.
I hope that you do not mind.

Please indicate where I had gone wrong.
I am not really familiar with Excel tables.

Thanks once again

Crow

 

[John_w]

Sorry, but preventing deletion of the Total Row completely escaped me. The fix is to lock the entire row in which the Total Row occurs.

Public Sub Lock_Table_Header_and_Total_Rows()

    Dim table As ListObject
    
    With ActiveSheet
        .Cells.Locked = False
        Set table = .ListObjects(1)
        table.HeaderRowRange.Locked = True
        table.TotalsRowRange.EntireRow.Locked = True   'have to lock entire Total Row, otherwise row can be deleted
        .Protect Password:="secret", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowInsertingRows:=True, AllowDeletingRows:=True
    End With
    
End Sub


Public Sub Unlock_Table_Header_and_Total_Rows()

    Dim table As ListObject
    
    With ActiveSheet
        .Unprotect Password:="secret"
        Set table = .ListObjects(1)
        table.HeaderRowRange.Locked = False
        table.TotalsRowRange.EntireRow.Locked = False
        .Cells.Locked = True
    End With
    
End Sub

 

[Eric Carolus]

Hi John_w

It works like a charm!
Thank you very much!

Crow