CODEWITHSUNDEEP
vbaexcel
Steven Gilbert
Steven Gilbert

Reputation: 35

Dynamically protect sheet from accidental deletion in Excel

I am trying to put a dynamic protection on the sheets in my workbook. I have many different sheets and sometimes I delete a sheet that I still need by accident.

If Cell OP15 contains a value, this means I am okay to delete the sheet to clean up my workbook. How do I create a protection for the sheets that only lets me delete it if Cell OP15 contains a value?

The closest thing I can find on the internet is something along these lines:

     ActiveSheet.Unprotect
     ' your vba code here
     ActiveSheet.Protect

Upvotes: 1

Views: 3398

Answers (2)

SeanC
SeanC

Reputation: 15923

The .BeforeDelete does not have a cancel, so you can't stop them deleting the sheet.

from this website, you can copy the sheet, and save it from deletion that way. You could use this routine to decide if you need to save the sheet from deletion or not:

Private Sub Worksheet_BeforeDelete()

Dim MyName As String

'Abort if no value in OP15
if [OP15].value <> "" then exit sub

'Capture the original worksheet name
MyName = ThisWorkbook.ActiveSheet.Name

'Rename the worksheet
ThisWorkbook.ActiveSheet.Name = Left(MyName, 30) + "#"

'Create a copy of the worksheet
ThisWorkbook.ActiveSheet.Copy _
After:=Sheets(ThisWorkbook.ActiveSheet.Index)

'Name the copy to the original name
ThisWorkbook.ActiveSheet.Name = MyName

End Sub

Upvotes: 1

Steven Gilbert
Steven Gilbert

Reputation: 35

This code is pasted into the sheet code for my admin template. Cell A1 is hardcoded to say "admin template". When the template is copied Cell A1 changes to the name of the new tab. 

     Option Explicit

     Private Sub Worksheet_Deactivate()

     'This sub prevents acidental deletion of tab until it has been hardcoded

     If Range("a1").Value = "admin template Ticket Info" Then
     ThisWorkbook.Protect , False
     Exit Sub
     End If

     If Range("OP15").Value <> "" Then
     MsgBox "Cannot delete tab until the Onboarding details have been hardcoded."
     Exit Sub
     End If

     ThisWorkbook.Protect , True

     Application.OnTime Now, "Unprotectbook"

     End Sub

This is copied into one of the modules

     Sub UnprotectBook()

     ThisWorkbook.Unprotect

     End Sub

Upvotes: 0

Related Questions