I have a Excel project where there is a workbook with “required” worksheets (users cannot delete them) but users can add / modify other sheets. So the workbook structure cannot be protected, yet I have to make sure these required worksheets are not deleted.
I am using Excel 2010, which does not have a Worksheet Delete event. This does exist in Excel 2013, but even that event does not have a Cancel method.
So I needed to develop a solution to handle this issue. Here are two methods. The first is fairly complex, but it works. But then I discovered method 2, which is much cleaner and simpler. The method 1 approach may still have some value, particularly if you need to create a customized worksheet delete event.
Method 1 – Complex method
Create a customized worksheet delete event
The basic approach is to first recognize if a worksheet has been deleted, basically creating a customized WorksheetDelete Event. This is done by counting the number of worksheets in the SheetDeactivate Event (storing that value in a global variable) and then performing the same count in the SheetActivate Event. If the count has decreased, then you know the user deleted a worksheet. If this worksheet is not allowed to be deleted, then it must be restored. This could be useful for special processing after a worksheet is deleted.
Private Sub Workbook_SheetDeactivate(ByVal ws As Object) '** iWksCountBefore was declared as a global variable iWksCountBefore = ActiveWorkbook.Sheets.Count Private Sub Workbook_SheetActivate(ByVal ws As Object) iWksCountAfter = ActiveWorkbook.Sheets.Count If iWksCountAfter < iWksCountBefore Then '** The worksheet was deleted - do something Else End If Exit Sub ErrorHandling: End Sub
Ok – that part was simple. The problem was what to do if the user was not allowed to delete that particular worksheet. How do you restore it?
Restoring the Worksheet
In order to restore the worksheet, some preliminary steps need to be taken.
- Back up the worksheet in the WorksheetDeactivate Event. I found that copying the worksheet to another worksheet in the workbook ultimately created issues with Range Name. So instead I copy the worksheet to a temporary workbook.
- Store all of the named ranges into a global array. We will need this later
- If the “protected” worksheet was deleted, recognize that in the WorksheetActivate Event and copy back the backed up worksheet to this workbook. (Prior to restoring the worksheet, you need to turn off events (Application.EnableEvents = False) so the restoration does not kick off another Sheet Activate / Deactivate event causing an endless loop)
- When the worksheet from the temporary workbook is copied, range names can still refer back to the temp file. In order to clean this up, you need to do 3 things:
- Delete all range names in the workbook
- Recreate the range names by using the stored Named Range data in the global array (see step 2)
- Prior to restoring the worksheet, you need to turn off events (Application.EnableEvents = False) so the restoration does not kick off another Sheet Activate / Deactivate event causing an endless loop
- Delete the temporary file
This is a lot of code, kind of clunky but it works. Go to the bottom of this entry to see the code.
Method 2 – Much more elegant with a lot less code
(credit for this idea must be given to Jan Karel Pieterse – see link: http://datapigtechnologies.com/blog/index.php/prevent-worksheet-delete-without-workbook-protection/#respond )
In Excel 2013, there is a worksheet delete event but it does not have a cancel method. In earlier versions, there is no worksheet delete event at all. In Excel 2010 (and I assume earlier versions), the events occur in the following order for adding and deleting a worksheet:
- Worksheet added (runs immediately before the Workbook_SheetDeactivate event)
- Workbook_SheetDeactivate Event called
- Worksheet Deleted (runs immediately after Workbook_SheetDeactivate but before Workbook_SheetActivate)
- Workbook_SheetActivate Event called
Remember, we have Workbook protection off so the user can add worksheets. This occurs before the Workbook_SheetDeactivate event. But what about worksheets that a user deletes? Let’s assume a user tries to delete a required worksheet. If we can turn Workbook protection on in the Workbook_SheetDeactivate event, the Worksheet Delete cannot occur. After we have protected the sheet from being deleted, we then need to turn Worksheet Protection off.
So here is the solution.
Private Sub Workbook_SheetDeactivate (ByVal ws as object)
‘** set the condition here that determines if this particular worksheet is to
‘** be protected from deletion and run the following code if true.
‘ ……….
‘** Step 1: Turn on protection
ThisWorkbook.Protect, True
‘** Step 2: Call sub that turns off protection using the Application.OnTime method (I do not yet ‘**understand why this works and a direct sub or function call does not work)
‘**
Application.OnTime Now, “ThisWorkbook.UnprotectBook
End Sub
Public Sub UnprotectBook()
ThisWorkbook.Unprotect
End Sub
What is happening here?
Step 1 – turns on Workbook protection
Step 2 – calls the UnprotectBook sub. But before this sub is run, Excel attempts the worksheet delete. Since the workbook is now protected, the worksheet delete fails and the user gets the system message:
Workbook is protected and cannot be changed
(can anyone figure out how to replace this with a custom message?)
The SheetActivate event is never run because the worksheet deletion did not occur so focus remains on the current worksheet.
Step 3 – now the UnprotectBook sub is run and workbook protection is turned off.
A much simpler solution.
Method 1 Code
Here is the code for Method 1
Private Sub Workbook_SheetDeactivate(ByVal ws As Object)
Call StoreAllNamedRanges(ActiveWorkbook)
Call CopyWorksheetAsTemp(ws)
iWksCountBefore = ActiveWorkbook.Sheets.Count
Application.EnableEvents = True
End Sub
Private Sub xWorkbook_SheetActivate(ByVal ws As Object)
Dim xlWB_Scorecard As Workbook
Dim xlWB_Temp As Workbook
Dim xlWS_Temp As Worksheet
Dim sCurrentSheetName As String
'** The parameter bDeleteWorksheetProtection" determines if this code will run
'** It is set to false while it is developed. This is used as a global variable
'** since the range name is lost if the admin worksheet is deleted
Set xlWB_Scorecard = ActiveWorkbook
'MsgBox "activate"
iWksCountAfter = ActiveWorkbook.Sheets.Count
'** If the worksheet count decreased, then a worksheet was deleted
If iWksCountAfter < iWksCountBefore Then
Set xlWB_Temp = Workbooks.Open("Temp1")
Set xlWS_Temp = xlWB_Temp.Worksheets(1)
xlWB_Scorecard.Activate
'** This assumes you want to prevent this worksheet deletion - you need code here to determine that
'** Before copy back the Admin worksheet - delete all the range names / copy the worksheet / then add
'** the range names back
Call ClearAllNamedRanges(ThisWorkbook)
Application.EnableEvents = False
xlWS_Temp.Copy ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Application.EnableEvents = True
'** The range names need to be cleared again after copying in the Temp worksheet
Call ClearAllNamedRanges(ThisWorkbook)
Call LoadAllNamedRanges(ThisWorkbook)
xlWB_Temp.Close savechanges:=False
Else
End If
If IsFile("Temp1.xlsm") Then
Kill "Temp1.xlsm"
Else
End If
Application.EnableEvents = True
End Sub
'*************
Public Function StoreAllNamedRanges(xlWB As Workbook) As String()
'** This function stores all named ranges in a workbook into an array
'** The array is two dimensional -
'** Dimension 1 - the identifier of the named range
'** Dimension 2 - the attribute of the array where:
'** 1=name 2= refersto 3= Scope (wb or ws) 4= comment
'************************************************************************
Dim iRangeCount As Integer
Dim i As Integer
Dim rngName As Name
'Set wb = ActiveWorkbook
iRangeCount = xlWB.Names.Count
ReDim sAllRanges(1 To iRangeCount, 1 To 4)
For Each rngName In xlWB.Names
i = i + 1
sAllRanges(i, 1) = rngName.Name
sAllRanges(i, 2) = rngName.RefersTo
If TypeOf rngName.Parent Is Workbook Then
sAllRanges(i, 3) = "wb"
Else
sAllRanges(i, 3) = "ws"
End If
sAllRanges(i, 4) = rngName.Comment
Next rngName
End Function
'***********
Public Sub CopyWorksheetAsTemp(xlWSSource As Worksheet)
'** This sub copies the current scorecard worksheet to a new worksheet
'** and retains the existing data
'enable events are turned off during this process
Dim sMsg As String
Dim iRet As Integer
Application.EnableEvents = False
xlWSSource.Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "Temp1", FileFormat:=52
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
Public Function ClearAllNamedRanges(xlWB As Workbook) As String()
'** This function clears all named ranges in a workbook
'************************************************************************
Dim rngName As Name
For Each rngName In xlWB.Names
rngName.Delete
Next rngName
End Function
'********
Public Function LoadAllNamedRanges(xlWB As Workbook) As String()
'** This function load all named ranges from an array into the specified workbook
'** The array is two dimensional -
'** Dimension 1 - the identifier of the named range
'** Dimension 2 - the attribute of the array where:
'** 1=name 2= refersto 3= Scope (wb or ws) 4= comment
'************************************************************************
Dim iRangeCount As Integer
Dim i As Integer
Dim xlWS As Worksheet
Dim iPosition As Integer
Dim sWorksheet As String
Set xlWS = xlWB.ActiveSheet
'Set wb = ActiveWorkbook
For i = 1 To UBound(sAllRanges, 1)
If sAllRanges(i, 3) = "wb" Then
xlWB.Names.Add Name:=sAllRanges(i, 1), RefersTo:=sAllRanges(i, 2)
Else
'Determine the worksheet for the range
iPosition = InStr(1, sAllRanges(i, 2), "!")
sWorksheet = Mid(sAllRanges(i, 2), 2, iPosition - 2)
'** Replace the apostrophe found in worksheets that have spaces with a null space
sWorksheet = Replace(sWorksheet, "'", "")
Set xlWS = xlWB.Sheets(sWorksheet)
xlWS.Names.Add Name:=sAllRanges(i, 1), RefersTo:=sAllRanges(i, 2)
End If
Next i
End Function
Mogul Technology 