Silver Contributor

Jan 10, 2024

Solved

VBA Delete all sheets excluding a few known

Hi guys

I thought I could solve this on my own but I'm not sure I'd be able to do it in the end 😞

Basically, what I need to do is:

#1 Store all existing sheetnames from the active workbook in an array
#2 Filter that array to exclude a list of known sheet names
Ultimately the goal is to delete all sheets BUT the known ones

I can do #1 but I'm obviously not taking the right approach to get what I need
In the attached sample workbook 'HIDDEN_DEV_SHEET' has a table listing the know sheet names to exclude

Open to suggestions/alternatives... Thanks

Lorenzo The snippet you found can be applied as follows:

Sub DeleteOtherSheets()

    Dim tbl As ListObject, arr() As Variant, i As Long
    Set tbl = ThisWorkbook.Worksheets("HIDDEN_DEV_SHEET").ListObjects(1)
    ReDim arr(1 To tbl.ListRows.Count)
    For i = 1 To tbl.ListRows.Count
        arr(i) = tbl.DataBodyRange(i, 1).Value
    Next i

    Dim Item As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each Item In ThisWorkbook.Worksheets
        If UBound(Filter(arr, Item.Name)) = -1 Then Item.Delete
    Next Item
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

I was working on something similar with arrays, using the Filter function to reduce the list of sheet names upon each iteration by setting the optional Include parameter to False...

Sub DeleteOtherSheets()

'Load all worksheet names into an array
    Dim sheetList() As Variant, wsCount As Long, i As Long
    wsCount = ThisWorkbook.Worksheets.Count
    ReDim sheetList(1 To wsCount)
    For i = 1 To wsCount
        sheetList(i) = ThisWorkbook.Worksheets(i).Name
    Next i

'Remove HIDDEN_DEV_SHEET from the sheet list
    Dim ws As Worksheet, removeList As Variant
    Set ws = ThisWorkbook.Worksheets("HIDDEN_DEV_SHEET")
    removeList = Filter(sheetList, ws.Name, False)

'Remove each name in the table from the sheet list
    Dim tbl As ListObject, rowCount As Long
    Set tbl = ws.ListObjects(1)
    rowCount = tbl.ListRows.Count
    If rowCount > 0 Then
        Dim arr As Variant
        arr = tbl.ListColumns(1).DataBodyRange.Value
        If rowCount = 1 Then
        ' single item
            If Len(arr) > 0 Then
                removeList = Filter(removeList, arr, False)
            End If
        Else
        ' multiple items
            For i = LBound(arr, 1) To UBound(arr, 1)
                If Len(arr(i, 1)) > 0 Then
                    removeList = Filter(removeList, arr(i, 1), False)
                End If
            Next i
        End If
    End If

'Delete each worksheet in the filtered list
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For i = LBound(removeList) To UBound(removeList)
        ThisWorkbook.Worksheets(removeList(i)).Delete
    Next i
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

EDIT: I discovered a few little quirks with this method (ie: if the table contains blank rows), so the code has been updated to handle those scenarios.

FYI: I believe the 'Type Mismatch" error is caused when using a 2-dimensional array in the SourceArray parameter. An array created directly from a range (ie: arr = rg.Value) is automatically 2-dimensional, even if it's a single column. Cheers!

9 Replies

djclements

Bronze Contributor

Jan 10, 2024

Lorenzo If the list of names is known to the developer only (and does not change dynamically by user interaction), consider using the SELECT CASE method to test each worksheet name against. You can also use Option Compare at the top of the VBA module with Text or Binary to set case sensitivity.

Example 1: Case Sensitive

Option Compare Binary

Sub DeleteOtherSheets()
    Dim Item As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each Item In ThisWorkbook.Worksheets
        Select Case Item.Name
            Case "Index", "Summary", "Pivots", "HIDDEN_DEV_SHEET"
                'Do nothing
            Case Else
                Item.Delete
        End Select
    Next Item
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Example 2: Not Case Sensitive

Option Compare Text

Sub DeleteOtherSheets()
    Dim Item As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each Item In ThisWorkbook.Worksheets
        Select Case Item.Name
            Case "index", "summary", "pivots", "hidden_dev_sheet"
                'Do nothing
            Case Else
                Item.Delete
        End Select
    Next Item
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

djclements
Bronze Contributor
Jan 10, 2024
Lorenzo Further to my previous reply, if there's a chance the worksheet names may be changed for any reason, you may want to set custom "Code Names" for each worksheet you want to keep, then delete by Item.CodeName: For example:

Worksheet Properties: CodeName

Sub DeleteOtherSheets() Dim Item As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next For Each Item In ThisWorkbook.Worksheets Select Case Item.CodeName Case "Keep1", "Keep2", "Keep3", "Keep4" 'Do nothing Case Else Item.Delete End Select Next Item Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
- Lorenzo
  Silver Contributor
  Jan 10, 2024
  djclements
  
  Very interesting ideas and they're highly appreciated. Unfortunately the list of known sheets might evolve/change and - where possible - I'd like to have nothing to change on the VB side
  
  The actual scenario is much more complex than what I exposed...
  THANK YOU

HansVogelaar

MVP

Jan 10, 2024

Lorenzo

Not what you asked, but a macro to delete all sheets except those in the list:

Sub DeleteSomeSheets()
    Dim rng As Range
    Dim found As Range
    Dim i As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error GoTo ErrHandler
    Set rng = Worksheets("HIDDEN_DEV_SHEET").ListObjects("TableDontDel").DataBodyRange
    For i = Worksheets.Count To 1 Step -1
        Set found = rng.Find(What:=Worksheets(i).Name, LookAt:=xlWhole)
        If found Is Nothing Then
            Worksheets(i).Delete
        End If
    Next i
ExitHandler:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Lorenzo

Silver Contributor

Jan 10, 2024

HansVogelaar

I can do what I want with your snippet - Thanks again

For the record I found this before posting:

For Each ws In ActiveWorkbook.Worksheets
    If UBound(Filter(arr, ws.Name)) = -1 Then ws.Delete
Next ws

in How to delete all sheets except those in list but I couldn't adapt it - type mistmatch I couldn't resolve 😞

djclements

Bronze Contributor

Jan 10, 2024

Lorenzo The snippet you found can be applied as follows:

Sub DeleteOtherSheets()

    Dim tbl As ListObject, arr() As Variant, i As Long
    Set tbl = ThisWorkbook.Worksheets("HIDDEN_DEV_SHEET").ListObjects(1)
    ReDim arr(1 To tbl.ListRows.Count)
    For i = 1 To tbl.ListRows.Count
        arr(i) = tbl.DataBodyRange(i, 1).Value
    Next i

    Dim Item As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each Item In ThisWorkbook.Worksheets
        If UBound(Filter(arr, Item.Name)) = -1 Then Item.Delete
    Next Item
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

I was working on something similar with arrays, using the Filter function to reduce the list of sheet names upon each iteration by setting the optional Include parameter to False...

Sub DeleteOtherSheets()

'Load all worksheet names into an array
    Dim sheetList() As Variant, wsCount As Long, i As Long
    wsCount = ThisWorkbook.Worksheets.Count
    ReDim sheetList(1 To wsCount)
    For i = 1 To wsCount
        sheetList(i) = ThisWorkbook.Worksheets(i).Name
    Next i

'Remove HIDDEN_DEV_SHEET from the sheet list
    Dim ws As Worksheet, removeList As Variant
    Set ws = ThisWorkbook.Worksheets("HIDDEN_DEV_SHEET")
    removeList = Filter(sheetList, ws.Name, False)

'Remove each name in the table from the sheet list
    Dim tbl As ListObject, rowCount As Long
    Set tbl = ws.ListObjects(1)
    rowCount = tbl.ListRows.Count
    If rowCount > 0 Then
        Dim arr As Variant
        arr = tbl.ListColumns(1).DataBodyRange.Value
        If rowCount = 1 Then
        ' single item
            If Len(arr) > 0 Then
                removeList = Filter(removeList, arr, False)
            End If
        Else
        ' multiple items
            For i = LBound(arr, 1) To UBound(arr, 1)
                If Len(arr(i, 1)) > 0 Then
                    removeList = Filter(removeList, arr(i, 1), False)
                End If
            Next i
        End If
    End If

'Delete each worksheet in the filtered list
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For i = LBound(removeList) To UBound(removeList)
        ThisWorkbook.Worksheets(removeList(i)).Delete
    Next i
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

EDIT: I discovered a few little quirks with this method (ie: if the table contains blank rows), so the code has been updated to handle those scenarios.

Lorenzo
Silver Contributor
Jan 10, 2024
HansVogelaar
Not exactly what I asked but this does the job 🙂
The actual scenario is a bit more complex, I'll see if I can adapt it on my own...

THANK YOU

Forum Discussion

VBA Delete all sheets excluding a few known

9 Replies

Resources