Excel delete all sheets except active sheet and specified sheets using codenames

Question

What would be the best way to delete all the sheets in the active Workbook, except the selected/active sheet and 4 specified sheets, using their CodeNames?

I've come up with this code and it works, but it seems like there would be a better way to do it:

Sub delete_test()


Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Deletes all sheets except ActiveSheet and specified sheets using codenames
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
Select Case ws.CodeName
Case "Sheet1", "Sheet2", "Sheet3", "Sheet4"
        Case Else
    With ws

If ws.NAme <> ThisWorkbook.ActiveSheet.NAme Then
ws.Delete
End If

    End With
End Select
Next


End Sub

Answer 1

Your code is already fairly concise.

You can add the ThisWorkbook.ActiveSheet.Name to the first Case and avoid the IF.

Also the With Block is not needed as you are only doing one thing. The extra typing is more than simply referring to the sheet.

Make sure you turn your alerts back on.

Sub delete_test()


Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Deletes all sheets except ActiveSheet and specified sheets using codenames
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
    Select Case ws.CodeName
        Case "Sheet1", "Sheet2", "Sheet3", "Sheet4", ThisWorkbook.ActiveSheet.CodeName
        Case Else
            ws.Delete
    End Select
Next

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 2

You could check if ws is Not ActiveSheet , and then check if CodeName is not one of your criteria.

Sub delete_test()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Deletes all sheets except ActiveSheet and specified sheets using codenames
Dim ws As Worksheet

For Each ws In ThisWorkbook.Sheets
    If Not Worksheets(ws.Name) Is ActiveSheet Then '<-- first check if sheet is not active sheet
        Select Case ws.CodeName
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet4"

            Case Else
                ws.Delete
        End Select
    End If
Next ws 

End Sub