Solved: Limit the Number of Sheets in A Workbook

[CaptRon]

I have a workbook that allows users to click a button and create duplicate sheets of a particular sheet, but I need to put a limit on the number of these copied sheets.

How can I restrict the total number of sheets that can be contained in a workbook or somehow restrict how many times this sheet can be duplicated?

Thanks,

[gnod]

Maybe it will help..
Disable the Insert -> worksheet in the menu bar and in the sheet tab.. also, the Move or Copy..


Public Sub Disable()
With Application
.CommandBars("Worksheet Menu Bar").Controls("Insert").Controls("Worksheet").Enabled = False
.CommandBars("Ply").Controls("Insert...").Enabled = False
.CommandBars("Ply").Controls("Move or Copy...").Enabled = False
End With
End Sub

Public Sub Enable()
With Application
.CommandBars("Worksheet Menu Bar").Controls("Insert").Controls("Worksheet").Enabled = True
.CommandBars("Ply").Controls("Insert...").Enabled = True
.CommandBars("Ply").Controls("Move or Copy...").Enabled = True
End With
End Sub

[Norie]

Ron

You could use the NewSheet workbook event.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Const MaxSheets = 3

If Worksheets.Count > MaxSheets Then
MsgBox "You can only have " & MaxSheets & " worksheets"
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = False
End If

End Sub

[CaptRon]

Choosing the precise moment to disable is the trick because I want them to be able to copy this worksheet (not insert) but only a limited number of times.

In my little pumpkin head, I was thinking about having Excel consider how many sheets the workbook had been expanded to and add code in my copy macro that would not permit the copy process when the predetermined number of sheets had been reached. If the number of sheets = X, then no more copy.

I just don't know how to achieve that.

[CaptRon]

Norie,

That did it. Thanks so much!

[mdmackillop]

Hi Norie,
That was my first thought as well, but it fails if you copy an existing sheet (don't know why!)

Try

Sub CheckSheet(Sh As Worksheet)
If Sheets.Count = 10 Then
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
MsgBox ("Limit reached")
End If
End Sub

This is called from the sheet copy button
Sub AddSheets()
Dim Sh As Worksheet
Sheets("Template").Copy after:=Sheets(Sheets.Count)
Set Sh = ActiveSheet
CheckSheet Sh
End Sub

or the NewSheet event

Sub Workbook_NewSheet(ByVal Sh As Object)
CheckSheet Sh
End Sub

[CaptRon]

Norie,

The code you provided only works when inserting a NEW worksheet. No problem.

I used your code but with the SheetActivate event and it works like a charm.


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Const MaxSheets = 14 '4 permanent sheets

If Worksheets.Count > MaxSheets Then
MsgBox "You can only create 10 ACT-34 sheets. "
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = False
End If

End Sub


It creates that 11th sheet, holds it in suspension while it displays the msg above, then deletes it when the user responds. Beautiful! Just what I was looking for. Thanks.

[CaptRon]

I have one other issue to try to resolve. I am looking for a way to reset the workbook to its original condition (the 4 original worksheets minus the 1-10 copied ACT-34 sheets). When I try to create a delete routine using an array, I run into trouble because the user might only create ACT-34 (2) through ACT-34 (5), so my array that includes ACT-34 (2) through ACT-34 (10) gives me an error. The sheets beyond ACT-34 (5) weren't created....they don't exist.

I need to find a way to delete all the sheets in the workbook EXCEPT the four original sheets.

Any ideas? Thanks.

[mdmackillop]

Replace the array values with your original sheet names
Sub Macro1()
Dim oSh, sh As Worksheet, chk As Long
oSh = Array("Sh1", "sh2", "sh3", "sh4")
Application.DisplayAlerts = False
For Each sh In Worksheets
On Error Resume Next
chk = Application.WorksheetFunction.Match(sh.Name, oSh, 0)
If chk = 0 Then sh.Delete
chk = 0
Next
Application.DisplayAlerts = True
End Sub
or
Sub Macro2()
Application.DisplayAlerts = False
For Each sh In Worksheets
If Left(sh.Name, 3) = "ACT" Then sh.Delete
Next
Application.DisplayAlerts = True
End Sub

[CaptRon]

That's got it! This code deletes all but what I want to keep. Thanks again.