remove all sheets till a given set of names using VBA - vba

Question

I want to remove all sheets in the current workbook exception the list in {A2,A3, ... } and the sheet with name Summary.
I wrote the following code
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Summary").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbook = ActiveWorkbook
For Each xWs In wbook.Worksheets
For Each MyCell In MyRange
If xWs.Name <> MyCell.Value And xWs.Name <> "Summary" Then
xWs.Delete
End If
Next MyCell
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
but I get an run time error which I do not know what it is.
Then, I tried to run line by line: in the first loop over "xWs.Name= Summary" there is no problem first for the second sheet I get an error at
If xWs.Name <> MyCell.Value And xWs.Name <> "Summary" Then
I know that this code is not efficient at all, because if a name matches it is still running till the end of set of names. However, I did not know how I can compare tow sets in VBA in a efficient way.
One can see in the the list of names in A-column.

Answer 1

You need to approach it a little different, you need to loop though the Range on every Sheet, once you have a match you need to raise a flag not to delete this Sheet.
Try the code below:
Sub DeleteSelectedSheets()
Dim MyCell As Range, MyRange As Range
Dim wbook As Workbook, xWs As Worksheet
Dim DeleteSheetFlag As Boolean
Set MyRange = Sheets("Summary").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbook = ActiveWorkbook
For Each xWs In wbook.Worksheets
DeleteSheetFlag = True
For Each MyCell In MyRange
Select Case xWs.Name
Case MyCell.Value, "Summary"
DeleteSheetFlag = False
Exit For
End Select
Next MyCell
If DeleteSheetFlag Then
xWs.Delete
End If
Next xWs
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub