CODEWITHSUNDEEP
vbaexcel
Majid
Majid

Reputation: 87

Adding array to sheet names

I am using the below code to retain sheets that I need and delete the rest. 

Sub DeleteSheets1()
    Dim xWs As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Sheet1" And xWs.Name <> "Sheet2" Then
            xWs.Delete
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

I have around 6 sheets that I want to retain. I need help modifying the syntax to accommodate multiple sheets. Something like below

if xWs.Name <> ("sheet1", "sheet2"....) then xws.delete

Upvotes: 0

Views: 163

Answers (4)

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19782

Ok, this one doesn't quite fulfil the requirement of an array, but it's another way of using a single loop.

It looks for an occurrence of the sheet name in the RetainSheets string. Each sheet name is surrounded by | just in case there's a sheet name within a sheet name eet1Sh as an example.
The code will not attempt to delete the last worksheet in the workbook either.

Sub Test()

    Dim wrkSht As Worksheet
    Dim RetainSheets As String

    RetainSheets = "|Sheet1|Sheet2|"

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each wrkSht In Worksheets
        If InStr(RetainSheets, wrkSht.Name) = 0 And Worksheets.Count > 1 Then
            wrkSht.Delete
        End If
    Next wrkSht

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Upvotes: 0

YasserKhalil
YasserKhalil

Reputation: 9538

Another approach

Sub Test()
Dim ws          As Worksheet
Dim arr         As Variant

arr = Array("Sheet1", "Sheet2", "Sheet3")

Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
        If Not IsNumeric(Application.Match(ws.Name, arr, 0)) Then ws.Delete
    Next ws
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Upvotes: 0

Vityata
Vityata

Reputation: 43585

The valueInArray boolean function could work the code easier:

Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean

    Dim cnt As Long

    For cnt = LBound(myArray) To UBound(myArray)
        If CStr(myValue) = CStr(myArray(cnt)) Then
            valueInArray = True
            Exit Function
        End If
    Next cnt

End Function

Sub DeleteSheets()


    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim cnt As Long
    cnt = Worksheets.Count

    Dim arrWks As Variant
    arrWks = Array("Sheet1", "Sheet2", "Sheet3")

    For cnt = Worksheets.Count To 1
        If Not valueInArray(Worksheets(cnt).Name, arrWks) Then
            Worksheets(cnt).Delete
        End If
    Next cnt

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

The valueInArray function gets value to search for myValue and array where to search for this value myArray. It loops through all elements of the array and if it finds the same String of the passed value, it returns True and exits. If it is not found, it returns False, as this is the default.

Upvotes: 0

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

Here arr is an array of the sheets to retain:

Sub DeleteSheets1()
    Dim xWs As Worksheet, s As String, i As Long
    Dim skp As Boolean
    arr = Array("Sheet1", "Sheet2", "Sheet3")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    n = ActiveWorkbook.Worksheets.Count
    For i = n To 1 Step -1
        s = Sheets(i).Name
        skp = False
        For Each a In arr
            If s = a Then skp = True
        Next a
        If Not skp Then Sheets(i).Delete
    Next

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

Upvotes: 2

Related Questions