Adding array to sheet names - vba

Question

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

Answer 1

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

Answer 2

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.

Answer 3

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

Answer 4

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