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" <[email protected]> wrote in
message news:[email protected]...
>
> 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
>
>
> --
> davidm
> ------------------------------------------------------------------------
> davidm's Profile:
> http://www.excelforum.com/member.php...o&userid=20645
> View this thread: http://www.excelforum.com/showthread...hreadid=473686
>

[davidm]

Many thanks Mike. Your code works! As for setting the MINIMUM sheets, I 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.Add
Application.DisplayAlerts = True
MsgBox "You cannot have LESS THAN 3 sheets"
End If
End Sub

basically, replacing ActiveSheet.Delete by Sheets.Add. For some 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 will be counteracted by the Sheets.Add command. Excel rejects that logic. I 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" <[email protected]> wrote in
message news:[email protected]...
>
> Many thanks Mike. Your code works! As for setting the MINIMUM sheets, I
> 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.ADD
> Application.DisplayAlerts = True
> MsgBox "You cannot have LESS THAN 3 sheets"
> End If
> End Sub
>
> basically, replacing *ActiveSheet.Delete* by *Sheets.Add*. For some
> 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 will
> be counteracted by the Sheets.Add command. Excel rejects that logic. I
> am stumped.
>
>
> --
> davidm
> ------------------------------------------------------------------------
> davidm's Profile:
> http://www.excelforum.com/member.php...o&userid=20645
> View this thread: http://www.excelforum.com/showthread...hreadid=473686
>

[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" <[email protected]> wrote in
message news:[email protected]...
>
> 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
>
>
> --
> davidm
> ------------------------------------------------------------------------
> davidm's Profile:
> http://www.excelforum.com/member.php...o&userid=20645
> View this thread: http://www.excelforum.com/showthread...hreadid=473686
>

[davidm]

Thanks Mike. Your solution works like charm!

[Mike Fogleman]

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

Mike F
"davidm" <[email protected]> wrote in
message news:[email protected]...
>
> Thanks Mike. Your solution works like charm!
>
>
> --
> davidm
> ------------------------------------------------------------------------
> davidm's Profile:
> http://www.excelforum.com/member.php...o&userid=20645
> View this thread: http://www.excelforum.com/showthread...hreadid=473686
>