How do I limit number of sheets in a Workbook?

[davidm]

I have been scratching around in vain to write a code that will limit
the number of Worksheets in a Workbook to fall within a certain range.
For example, prevent the user from inserting new sheets if a maximum of
10 sheets is reached, and contrariwise, to prevent deletions if number
of sheets is 3.

I have a sneaking feeling that this task will need a Workbook event but
the following code failed me. In spite of the code, insertions/deletions
are carried out after the Msgbox displays. TIA

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Sheets.Count > 5 Then
MsgBox "You cannot have MORE THAN 5 sheets"
Exit Sub
End If
If Sheets.Count < 3 Then
MsgBox "You cannot have LESS THAN 3 sheets"
Exit Sub
End If
End Sub

 

[Mike Fogleman]

Here is the first part:

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Sheets.Count > 5 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
MsgBox "You cannot have MORE THAN 5 sheets"
End If
End Sub

I am not sure if you can restrict the minimum sheets to 3 yet. Still
looking.

Mike F

 

[davidm]

Many thanks Mike. Your code works! As for setting the MINIMUM sheets,
borrowed from your logic and came up with:

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Sheets.Count <= 3 Then
Application.DisplayAlerts = False
SHEETS.AD
Application.DisplayAlerts = True
MsgBox "You cannot have LESS THAN 3 sheets"
End If
End Sub

basically, replacing *ActiveSheet.Delete* by *Sheets.Add*. For som
strange reason, this code fails and deletions down from 3 (to 2 and 1
are allowed. You would imagine that any instance of an insertion wil
be counteracted by the Sheets.Add command. Excel rejects that logic.
am stumped

 

[Mike Fogleman]

This is real close but sheet numbers will have to be renamed by hand to keep
the code simple.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sheets.Count < 3 Then
Application.DisplayAlerts = False
Worksheets.Add
Application.DisplayAlerts = True
MsgBox "You cannot have LESS THAN 3 sheets"
End If
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Sheets.Count > 5 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
MsgBox "You cannot have MORE THAN 5 sheets"
ActiveWorkbook.Save
End If
End Sub

Mike F

 

[davidm]

Mike, good effort but there is a serious drawback. If you need to
limit the number of sheets to say 3, you would, in all probability,
want to leave all the existing sheets intact at the end of the day.

The code sadly deletes one of the 3 and replaces it with a new one. The
sheet count remains 3 but the composition has fatally altered. I have
tried a few things to no avail to cure this. It's all a question of
ALMOST there but NOT QUITE.

Anyhow, thanks for your input.

David.

 

[davidm]

Let me re-formulate the problem regarding setting the minimum no. of
sheets in a Workbook. (The Maximum flip-side is tractable and solved).
If we desire a minimum of N sheets:

1. Insertions may be allowed if Worksheets count is equal to/greater
than N;

2. While deletions can be done for as long as sheet count is greater
than
N.

3. When sheet count is exactly N, no fresh insertions should be
allowed. (This is the crux of the problem).

4. But should the sheet count happen to be less than N, for a start,
insertions
could be permitted.


david

 

[Mike Fogleman]

OK, this should be real close to what you want. It will password protect the
workbook for any more sheet insertions/deletions, if there were 4 sheets and
now there are 3 (sheet number decreasing, not increasing) . At this point
when you right-click a sheet tab, Insert/Delete are dimmed. I threw in the
ElseIf statement and remarked it out. This statement will allow the user to
add a 4th and 5th sheet once he has deleted down to 3 sheets and locked the
WB. However, with the statement where it is, the message will pop up every
time you change sheets, if the number of sheets = 3. If you want the user to
have this option to add more sheets once they have deleted down to 3, then I
would suggest making the ElseIf statement into a Sub in a general code
module as a stand-alone macro.

Option Explicit
Public PrevwsCnt As Long

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim CurwsCnt As Long
Dim Response
CurwsCnt = Worksheets.Count
If PrevwsCnt = 4 And CurwsCnt = 3 Then
Application.DisplayAlerts = False
ActiveWorkbook.Protect password:="wb", structure:=True
MsgBox "You cannot have LESS THAN 3 sheets"
Application.DisplayAlerts = True
'ElseIf PrevwsCnt = 3 And CurwsCnt = 3 Then
' Response = MsgBox("Do you want to add a sheet?", vbYesNo)
' If Response = vbNo Then Exit Sub
' If Response = vbYes Then
' ActiveWorkbook.Unprotect password:="wb"
' Worksheets.Add
' End If
End If
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
If Sheets.Count > 5 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
MsgBox "You cannot have MORE THAN 5 sheets"
ActiveWorkbook.Save
End If
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
PrevwsCnt = Worksheets.Count
End Sub

Mike F

 

[davidm]

Thanks Mike. Your solution works like charm

 

[Mike Fogleman]

Thanks David for the feedback. I am glad it worked out.

Mike F