Delete Excel worksheets if not in array

3
votes

I am having problem to solve the error "time execution error #13: incompatible type". If user creates some worksheet that is not stated in the array, it will be deleted. Can anyone help?

sub DeleteNewSheets()

Dim ws, wsP As Worksheet
Dim ArrayOne As Variant

    Application.DisplayAlerts = False

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


    Set wsP = ThisWorkbook.Worksheets(ArrayOne) ' <--- ERROR #13

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> wsP.Name Then ws.Delete
    Next ws

    Application.DisplayAlerts = True

end sub
3
vbaexcel
the index for worksheets([index]) is an integer (or can be string), but not an array - Rosetta
u just need to loop through the array to check if a name is matched. If none is matched, then delete the worksheet - Rosetta
@Rosetta - The index for Worksheets can be an array of strings or integers. As a test, create a workbook with 3 sheets (Sheet1, Sheet2 and Sheet3), then execute Worksheets(Array("Sheet1", "Sheet2")).Visible = False. Both Sheet1 and Sheet2 will become hidden. - YowE3K
@Rosetta, thank you for your comments and time. - Luiz Vaughan

3 Answers

7
votes

Your line of code saying:

Set wsP = ThisWorkbook.Worksheets(ArrayOne)

is trying to set a Worksheet object to an array of many Worksheets. That's like trying to set a single Integer to be an array of Integers.

Try using the following code

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
1
votes

If you add an extra For ... Next or For Each ... Next statement to loop through every element in ArrayOne and conditional IFs statement then it should do the work. So your code should be like this

    Sub DeleteNewSheets()

    Dim ws As Worksheet
    Dim ArrayOne As Variant, iSheet As Integer

    Application.DisplayAlerts = False

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

    For Each ws In ThisWorkbook.Worksheets
        For iSheet = LBound(ArrayOne) To UBound(ArrayOne)
            If ws.Name = ArrayOne(iSheet) Then Exit For
            If iSheet = UBound(ArrayOne) Then
                ws.Delete
            End If
        Next
    Next

    Application.DisplayAlerts = True

End Sub

or alternatively

Sub DeleteNewSheets()

Dim ws As Worksheet
Dim ArrayOne As Variant

    Application.DisplayAlerts = False

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

    For Each ws In ThisWorkbook.Worksheets
        For Each Element In ArrayOne
            If ws.Name = Element Then Exit For
            If Element = ArrayOne(UBound(ArrayOne)) Then
                ws.Delete
            End If
        Next
    Next

    Application.DisplayAlerts = True

End Sub
0
votes

you can check sheets in one loop and delete "bad" ones in one shot as follows:

Option Explicit

Sub DeleteNewSheets()
    Dim ws As Worksheet
    Dim sheetsToDelete As String
    Const GOODSHEETS As String = "\SheetA\SheetB\SheetC\Sheet_n\" '<--| list of good sheets names, separated by an invalid character for sheet names 

    For Each ws In ThisWorkbook.Worksheets
        If InStr(GOODSHEETS, "\" & ws.Name & "\") = 0 Then sheetsToDelete = sheetsToDelete & ws.Name & "\" '<--| update sheets to be deleted list
    Next ws

    If sheetsToDelete <> "" Then '<--| if the list is not empty
        sheetsToDelete = Left(sheetsToDelete, Len(sheetsToDelete) - 1) '<--| remove last delimiter ("\") from it
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets(Split(sheetsToDelete, "\")).Delete '<-- delete sheets
        Application.DisplayAlerts = True
    End If
End Sub