Delete worksheets not specified in an array

[GeeWhiz7]

Hi folks,
I have a workbook with >50 worksheets that are "core" ones that never get deleted. On top of that my macros generate many other worksheets (dynamic # and not always same names) temporarily as I work with data. Before saving, I minimize the file size by deleting the temporary sheets. I do this by using something like the first snippet below. You can imagine that by having 50 or so sheets that can't get deleted, the number of IF AND entries is large.

Goal: To implement something much simpler and flexible to allow me to keep sheets that are defined by a list/array and delete the others.

Thanks for your help in advance!

Sub DeleteSheets()
Dim kount, i As Long

kount = This Workbook.Sheets.Count

For i = 1 to kount
If Sheets(i).Name <> "CoreNames" And Sheets(i).Name <> "Keep" And Sheets(i).Name <> "Keep2" _
Then
Sheets(i).Delete
End If
Next i
End Sub

What I have been working on to simplify is below. I can't quite figure out the syntax to make it work correctly as it will still delete the "core" worksheets because the loop iteration still will find instances where the <> condition is met.

Sub DelSh()

'Delete all sheets apart from Core ones defined on CoreNames A1+
'***************************************************
Dim CoreNamesSh As Worksheet
Dim CoreNames, CoreName As Variant
Dim kount As Integer
Dim k As Integer
    
Set CoreNamesSh = Worksheets("CoreNames")
'###Gets the list of worksheets to not delete
CoreNames = CoreNamesSh.Range("A1").CurrentRegion.Value

kount = ThisWorkbook.Sheets.Count
    
    For k = 1 To kount
    
        For Each CoreName In CoreNames
            If Sheets(k).Name = CoreName Then
            GoTo SkipCoreName
            
'###Can't figure how to modify this part to not delete core worsheets
'###defined in CoreNames array.  Because I am looping through each CoreName
'###it still has iterations where the sheet name is <> to CoreName

            ElseIf Sheets(k).Name <> CoreName Then
            Sheets(k).Delete
            
            End If

SkipCoreName:
        Next CoreName
    Next k

End Sub

 

[dmt32]

Hi,
create a simple table on worksheet listing all sheets not to delete & read that into an array

updated code

Sub DeleteSheets()
    Dim ws          As Worksheet
    Dim keepsheets  As Variant
   
    Application.DisplayAlerts = False
    With ThisWorkbook
        keepsheets = .Worksheets("Keep Sheets").Range("A1").CurrentRegion.Value
        For Each ws In .Worksheets
            If IsError(Application.Match(ws.Name, keepsheets, 0)) Then ws.Delete
        Next ws
    End With
     Application.DisplayAlerts = True
End Sub

Solution is dynamic but you MUST remember to keep the table worksheet name on the list.

Book1
	A
1	Keep Sheets
2	Sheet1
3	Sheet2
4	Sheet3
Keep Sheets

Dave

 

[GeeWhiz7]

Hi,
create a simple table on worksheet listing all sheets not to delete & read that into an array

updated code

Sub DeleteSheets()
    Dim ws          As Worksheet
    Dim keepsheets  As Variant
  
    Application.DisplayAlerts = False
    With ThisWorkbook
        keepsheets = .Worksheets("Keep Sheets").Range("A1").CurrentRegion.Value
        For Each ws In .Worksheets
            If IsError(Application.Match(ws.Name, keepsheets, 0)) Then ws.Delete
        Next ws
    End With
     Application.DisplayAlerts = True
End Sub

Solution is dynamic but you MUST remember to keep the table worksheet name on the list.

Book1
	A
1	Keep Sheets
2	Sheet1
3	Sheet2
4	Sheet3
Keep Sheets

Dave

Very nice indeed. I had not even thought of using Match. Thank you Dave!

 

[dmt32]

Very nice indeed. I had not even thought of using Match. Thank you Dave!

I use the Match function often especially in loops when there is a need to evaluate data against a list of values.
Glad solution does what you want & appreciate your feedback.

Dave