CODEWITHSUNDEEP
excelvba
Ryan Yeung
Ryan Yeung

Reputation: 45

I don't understand how the code read (VBA)

Delete Excel worksheets if not in array

The code below is used to delete worksheets that are not in the array. While the below code can run successfully, there is a problem from my understanding.

As there is a boolean "Matched" declared as False as default (root level), so if wsName = ws.Name, then it will be assigned Matched = True (parent level). So, for those that not wsName = ws.Name, they should be False right?

When those that are not matched and exit for the loop, and run the next line, they are supposed to be False and matched the parent False, but I don't understand why the next line said "If not Matched.." Quite contradict my logical thinking.

I am new to VBA so hope anyone can help me.

Sub DeleteNewSheets()

Dim ws As Worksheet
Dim ArrayOne() As Variant
Dim wsName As Variant
Dim Matched As Boolean

ArrayOne = Array("SheetA", "SheetB", "SheetC", "Sheet_n")

Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Worksheets
    Matched = False
    For Each wsName In ArrayOne
        If wsName = ws.Name Then
            Matched = True
            Exit For
        End If
    Next
    If Not Matched Then
        ws.Delete
    End If
Next ws

Application.DisplayAlerts = True

End Sub

Upvotes: 1

Views: 94

Answers (1)

VBasic2008
VBasic2008

Reputation: 54787

Delete Sheets with Exceptions

  • The following (different) approach illustrates how one could deal with some of the issues in the suggested code:
    • Case Sensitivity i.e. "SheetA" <> "sheetA"
      • Effectively handled with StrComp e.g.
        If StrComp("SheetA", "sheetA". vbTextCompare) = 0 Then
      • In this code, it is handled with Application.Match.
    • Visibility of the Sheets
      • There has to be at least one visible sheet left (xlSheetVisible).
      • You cannot delete a very hidden sheet (xlSheetVeryHidden), while you can delete a hidden sheet (xlSheetHidden).
    • Workbook Protection (main error handler)
Option Explicit

Sub DeleteSheetsTEST()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim Exceptions As Variant
    Exceptions = Array("SheetA", "SheetB", "SheetC", "Sheet_n")
    DeleteSheets wb, Exceptions
End Sub

Sub DeleteSheets( _
        ByVal wb As Workbook, _
        ByVal Exceptions As Variant)
    Const ProcName As String = "DeleteSheets"
    On Error GoTo ClearError
    
    Const Title As String = "Delete Sheets"
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim sh As Object
    For Each sh In wb.Sheets
        dict(sh.Name) = Empty
    Next sh
    
    Dim dictDel As Object: Set dictDel = CreateObject("Scripting.Dictionary")
    Dim dictKeep As Object: Set dictKeep = CreateObject("Scripting.Dictionary")
    
    Dim Key As Variant
    For Each Key In dict.Keys
        If IsNumeric(Application.Match(Key, Exceptions, 0)) Then
            dictKeep(Key) = Empty
        Else
            dictDel(Key) = Empty
        End If
    Next Key
    
    If dictDel.Count = 0 Then
        MsgBox "Nothing to delete. No action taken.", vbExclamation, Title
        Exit Sub
    End If
    
    If dictKeep.Count = 0 Then
        MsgBox "No sheets to keep. No action taken.", vbCritical, Title
        Exit Sub
    End If
    
    Dim FoundKeeper As Boolean
    For Each Key In dictKeep.Keys
        If wb.Sheets(Key).Visible = xlSheetVisible Then
            FoundKeeper = True
            Exit For
        End If
    Next Key
    
    If Not FoundKeeper Then
        MsgBox "No visible sheets to keep. No action taken.", vbCritical, Title
        Exit Sub
    End If
    
    For Each Key In dictDel.Keys
        If wb.Sheets(Key).Visible = xlSheetVeryHidden Then
            wb.Sheets(Key).Visible = xlSheetVisible
        End If
    Next Key
    
    Application.DisplayAlerts = False
    wb.Sheets(dictDel.Keys).Delete
    Application.DisplayAlerts = True
    
    MsgBox "Successfully deleted the following sheets:" & vbLf & vbLf _
        & Join(dictDel.Keys, vbLf), vbInformation, Title
    
ProcExit:
    Exit Sub
ClearError:
    MsgBox "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description, vbCritical
    Resume ProcExit
End Sub

Upvotes: 0

Related Questions