Delete sheets with execption

[av8tordude]

I have several sheets. Security, f2106, ####, ####, ####...etc (the 4-numbered sheets can be in any order). I would like delete all sheets, but keep "Security", "f2106" and "1-numbered sheet". Can someone assist...Thank you:friends:

[GTO]

I have several sheets. Security, f2106, ####, ####, ####...etc (the 4-numbered sheets can be in any order). I would like delete all sheets, but keep "Security", "f2106" and "1-numbered sheet". Can someone assist...Thank you:friends:

Greetings Aviator,

The "1-numbered sheet" part seems a bit less than clear. How about attaching a workbook (.xls format) with the possible sheets and a short explanation as to which should be left (remaining)?

Mark

[av8tordude]

Posted!

[GTO]

Posted!

Uhhh Nope. I said .xls format. I'm good for about 20-45 minutes, as it is late here, and I am working "tomorrow" (1400 hrs today actually). I'd like to help, but I cannot read anything formatted in 2007(+) at home.

[av8tordude]

Sorry about that.

[jolivanes]

Something like this maybe.

Sub Delete_Some_Sheets()
Dim wrkSheet As Worksheet
Application.ScreenUpdating = False
For Each wrkSheet In ActiveWorkbook.Worksheets
With wrkSheet
If .Name <> "Security" And _
.Name <> "f2106" And _
.Name <> "2012" Then
Application.DisplayAlerts = False
Sheets(.Name).Delete
Application.DisplayAlerts = True
End If
End With
Next wrkSheet
Sheets("2012").Name = "Calculator"
Application.ScreenUpdating = True
End Sub

[av8tordude]

Thanks jolivanes.

The only problem I see is this line....

.Name <> "2012" Then

I used the numbers in the attached book as examples. Those numbers will never be the same as listed in the book I attached. So I need something that is more flexible in identifying and keeping the last sheet name that is a number.

[GTO]

I am still unsure what "1-numbered sheet" means, but in the workbook, it seemed to me that we are just wanting to delete sheets named simply with a four-digit (year) number. If my understanding is correct, maybe like:

In a Standard Module:
Option Explicit

Sub example()
Dim DIC As Object ' Scripting.Dictionary
Dim wks As Worksheet
Dim arrSheetNames As Variant
Dim n As Long
Dim NewestName As Variant
Dim sMsg As String

Set DIC = CreateObject("Scripting.Dictionary")

'// Check each worksheet's name, seeing if the trimmed (in case any errant //
'// leading/trailing spaces) name is a four-digit number. If true, trim the //
'// sheet's name for later, and add the name to our dictionary's keys (as //
'// a number, so we can use MAX later to find the newest). //
For Each wks In ThisWorkbook.Worksheets
If Trim(wks.Name) Like "####" Then
wks.Name = Trim(wks.Name)
DIC.Item(CLng(wks.Name)) = Empty
End If
Next

'// Just to make sure we have at least one sheet to worry about. //
If DIC.Count > 0 Then
'// Flip the keys into an array (presuming we are using the dictionary //
'// late-bound) and find the newest/greatest name. //
arrSheetNames = DIC.Keys
NewestName = Application.Max(arrSheetNames)
'// We have the newest name stored, so delete this from keys and re-write //
'// the array. //
DIC.Remove (NewestName)
arrSheetNames = DIC.Keys
'// Optional: Build a message to confirm with the user. //
sMsg = "Deleting:" & vbCrLf & vbCrLf
For n = LBound(arrSheetNames) To UBound(arrSheetNames)
sMsg = sMsg & vbTab & arrSheetNames(n) & vbCrLf
Next
sMsg = sMsg & vbCrLf & "Renaming: " & NewestName & " to: Calculator"

'// Rename latest sheet and loop through our array to delete the others. //
If MsgBox(sMsg, vbQuestion Or vbYesNo, "STOP! Okay to delete?") = vbYes Then
ThisWorkbook.Worksheets(CStr(NewestName)).Name = "Calculator"
Application.DisplayAlerts = False
For n = LBound(arrSheetNames) To UBound(arrSheetNames)
ThisWorkbook.Worksheets(CStr(arrSheetNames(n))).Delete
Next
Application.DisplayAlerts = True
End If
End If
End Sub

Hope that helps,

Mark