Sheet Delete

[vmjan02]

I have this code is working all perfect, but only change is need that it will take the sheet name from the range and range will be till the end of the records.

Dim ws As Worksheet
    Application.DisplayAlerts = False   'Optional
  
    For Each ws In Worksheets
        Select Case ws.Name
            'Include sheet names to keep on next line (with comma between)
            Case Sheets("Report").Range("a1").Value, Sheets("Report").Range("a2").Value
                    ' Modify to check the sheet name till the end of the row
                'Do nothing
            Case Else
                ws.Delete
        End Select
    Next ws

    Application.DisplayAlerts = True

 

[vmjan02]

Hi got the solution

Private Sub CommandButton4_Click()
    Dim i As Long
    Dim cnt As Long
    Dim xWb, actWs As Worksheet
    Set actWs = ThisWorkbook.Worksheets("Report")
    cnt = 0
    Application.DisplayAlerts = False
    
    For i = Sheets.Count To 1 Step -1
        If Not ThisWorkbook.Sheets(i) Is actWs Then
            xWb = Application.Match(Sheets(i).Name, actWs.Range("A1:A15"), 0)
            If IsError(xWb) Then
                ThisWorkbook.Sheets(i).Delete
                cnt = cnt + 1
            End If
        End If
    Next
    Application.DisplayAlerts = True
    If cnt = 0 Then
        MsgBox "Not find the sheets to be seleted", vbInformation, "Data"
    Else
        MsgBox "Have deleted" & cnt & "worksheets"
    End If
End Sub