Excel VBA: Delete all worksheets except for specific ones you want to keep

Excel VBA code example: How to delete all worksheets except for specific ones ones you want to retain.

This came from real world need today so I pounded this code out.

  • I have a list of worksheets that I want to keep. 
  • I run a process that adds analyzed data from another file to a new “temp” worksheet (tab), and additional worksheets per vendor from parsing out the imported data in the temp worksheet.
  • I can end up with 10 new tabs of analyzed data including the temp sheet.
  • The code below deletes all worksheets not on a “keep sheet list” . Basically, resetting the spreadsheet back to the state it was in before I ran macro to import and process that data that added all the new sheets.

Excel VBA Example: ResetWorkbook Function

'Reset Workbook
'Author Rick Cable
'Date: 11/28/2018
'Title: ResetWorkbook
'Purpose:   Deletes any workbooks not on the keep sheet list,
'           resetting it to previous state if you've added them
'           from some other process and want to undo
'Version 1.0
Public Sub ResetWorkbook()
    Dim sht As Worksheet
    Dim arrKeepSheetList As Variant
    Dim strKeepSheetList As Variant
    Dim isOnList As Boolean
        
    Application.DisplayAlerts = False
    isOnList = False
    strKeepSheetList = "Instructions,Template,Sample CSV File,Data Elements,Config"
    arrKeepSheetList = Split(strKeepSheetList, ",")
    
    'Loop through each worksheet in ActiveWorkbook
     For Each sht In ActiveWorkbook.Worksheets
        isOnList = False
        'Look thru list of sheets to keep
        'if sheet is not on list, delete it
        For Each Item In arrKeepSheetList
            If sht.Name = Item Then
                isOnList = True
                'If isOnList Then
                '    Exit For
                'End If
            End If
        Next Item
            
        If isOnList Then
             'MsgBox (sht.Name & " is on the list")
        End If            
        
        If isOnList = False Then
            'MsgBox ("I would be deleting " & sht.Name & " right now!")
            Worksheets(sht.Name).Delete
        End If
        
    Next sht

    Application.DisplayAlerts = True

End Sub