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,
Before you criticize someone, you should walk a mile in their shoes. That way, when you criticize them, you're a mile away and you have their shoes.
Maybe it will help..
Disable the Insert -> worksheet in the menu bar and in the sheet tab.. also, the Move or Copy..
[VBA]
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
[/VBA]
Ron
You could use the NewSheet workbook event.
[vba]
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[/vba]
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.
Before you criticize someone, you should walk a mile in their shoes. That way, when you criticize them, you're a mile away and you have their shoes.
Norie,
That did it. Thanks so much!
Before you criticize someone, you should walk a mile in their shoes. That way, when you criticize them, you're a mile away and you have their shoes.
Hi Norie,
That was my first thought as well, but it fails if you copy an existing sheet (don't know why!)
Try
[vba]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
[/vba]
This is called from the sheet copy button
[VBA] Sub AddSheets()
Dim Sh As Worksheet
Sheets("Template").Copy after:=Sheets(Sheets.Count)
Set Sh = ActiveSheet
CheckSheet Sh
End Sub[/VBA]
or the NewSheet event
[vba]Sub Workbook_NewSheet(ByVal Sh As Object)
CheckSheet Sh
End Sub
[/vba]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
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.
[vba]
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
[/vba]
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.
Before you criticize someone, you should walk a mile in their shoes. That way, when you criticize them, you're a mile away and you have their shoes.
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.
Before you criticize someone, you should walk a mile in their shoes. That way, when you criticize them, you're a mile away and you have their shoes.
Replace the array values with your original sheet names
[vba] 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[/vba]
or
[VBA]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
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
That's got it! This code deletes all but what I want to keep. Thanks again.
Before you criticize someone, you should walk a mile in their shoes. That way, when you criticize them, you're a mile away and you have their shoes.
Posting Permissions
Reply With Quote
