In VBA how to keep two worksheets and delete other sheets - excel

Question

Hi everyone！ I'm trying to write a method in VBA to keep 2 worksheets and delete others at the same time.
I already did the one that will keep one worksheet and delete others like this:
Sub delete_all_pages_except_main()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Application.DisplayAlerts = False
If ws.Name <> "Home Page" Then
ws.Delete
End If
Next ws
End Sub
And I try to write it like this
If (ws.Name <> "Home Page" Or ws.Name <> "Data")
But VBA would accept it.
Can you guys help? Thank you.

Answer 1

This should do
Sub delete_all_pages_except_main()
Dim ws As Worksheet
Dim arr As Variant
Dim boo As Boolean
Application.DisplayAlerts = False
arr = Array("Home Page", "Data")
For Each ws In ThisWorkbook.Worksheets
boo = NoDel(ws.Name, arr)
If boo <> True Then ws.Delete
Next ws
Application.DisplayAlerts = True
End Sub
Function NoDel(ws As String, warr As Variant) As Boolean
NoDel = False
For i = LBound(warr, 1) To UBound(warr, 1)
If warr(i) = ws Then NoDel = True
Next i
End Function

Answer 2

Delete Sheets With Exceptions
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: In a specified workbook, writes all the sheet names '
' not specified in an Exceptions array to a Result array, and '
' using the Result array deletes all the sheets in one go. '
' Remarks: This solution applies to worksheets and chartsheets. '
' Since there is no Sheet object, the For Next loop (instead '
' of the For Each Next loop) and the Object type have '
' to be used. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub deleteSheets(Book As Workbook, Exceptions As Variant)
' Program
Dim SheetsCount As Long: SheetsCount = Book.Sheets.Count
Dim Result As Variant: ReDim Result(SheetsCount)
Dim sh As Object, i As Long, j As Long
j = -1
For i = 1 To SheetsCount: GoSub checkName: Next i
If j = -1 Then GoTo NothingToDelete
If j = SheetsCount - 1 Then GoTo NoExceptions
GoSub deleteSheetsInOneGo
MsgBox "Deleted '" & j + 1 & "' sheets.", vbInformation, "Success"
Exit Sub
' Subroutines
checkName:
Set sh = Book.Sheets(i)
If IsError(Application.Match(sh.Name, Exceptions, 0)) Then
j = j + 1
Result(j) = sh.Name
End If
Return
deleteSheetsInOneGo:
ReDim Preserve Result(j)
Application.DisplayAlerts = False
Book.Sheets(Result).Delete
Application.DisplayAlerts = True
Return
' Labels
NothingToDelete:
MsgBox "Sheets already deleted.", vbCritical, "Nothing to Delete"
Exit Sub
NoExceptions:
MsgBox "Cannot delete all sheets.", vbCritical, "No Exceptions"
Exit Sub
End Sub
' Usage Example
Sub runDeleteSheets()
Dim SheetNames As Variant: SheetNames = Array("Home Page", "Data")
deleteSheets ThisWorkbook, SheetNames
End Sub