Self Deleting Sheet

lenze

Legend
Joined
Feb 18, 2002
Messages
13,690
I have a workbook with 2 sheets in it. On one sheet is a Pivot Table based on an MSQuery. When a user double clicks data in the table, a new sheet is added with the details for that data point. Is there away to make this new sheet self delete before saving? I thought maybe looping through each sheet and deleting those not named correctly. Is that feasible?
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Richie(UK)

MrExcel MVP
Joined
May 17, 2002
Messages
3,329
Hi lenze,

How about something like this, where "Sheet1" and "Sheet2" are the names of the sheets you wish to keep.

<pre>
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet

For Each ws In Sheets
If ws.Name <> "Sheet1" Then
Application.DisplayAlerts = False
'stop warning message re sheet delete
If ws.Name <> "Sheet2" Then ws.Delete
Application.DisplayAlerts = True
End If
Next

End Sub

</pre>

HTH
 

Mudface

MrExcel MVP
Joined
Feb 18, 2002
Messages
3,339
The following might work OK for you, the sheet names are transferred to a named range on a new hidden sheet on opening the workbook. Any sheet not named at the start (including the new sheet) is then deleted upon closing: -

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim ws As Worksheet
Dim x
Dim y As Integer
Dim flag As Boolean

x = Parent.Range("SheetNames")
Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Worksheets
    flag = False
    For y = 1 To UBound(x, 1)
        If x(y, 1) = ws.name Then flag = True: Exit For
    Next y
    If Not flag Then ws.Delete
Next ws

Application.DisplayAlerts = True
ThisWorkbook.Save

End Sub

Private Sub Workbook_Open()

Dim ws As Worksheet
Dim x As Integer

Application.ScreenUpdating = False

With Worksheets.Add

x = 1
For Each ws In ThisWorkbook.Worksheets
    If ws.name<> .name Then
        .Range("A" & x) = ws.name
        x = x + 1
    End If
Next ws

.Range("A1", .Range("A63336").End(xlUp)).name = "SheetNames"

End With

Application.ScreenUpdating = True

End Sub

Seems a bit long-winded but it appears to work OK.
This message was edited by Mudface on 2002-09-16 12:32
 

Mudface

MrExcel MVP
Joined
Feb 18, 2002
Messages
3,339
My original one used the BeforeSave event, which won't work if you Save more than once in a session (doh!), so I've edited the above to use the BeforeClose.
 

Forum statistics

Threads
1,144,765
Messages
5,726,175
Members
422,660
Latest member
mrsteele

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top