Delete sheet if it's name is matched n a range on another tab

[EEEEEE]

Hi,
I need to macro to check all sheets within my work book and if the sheet name is matched in a named range("specific activity" located only on sheet "all lists") I want to delete the sheet/s when their name is matched in this range.

I've been searching and found different examples but I cannot get the to work. I don't really understand the application.match. I think the below just refers to a range on the active sheet. I want it to always check the names range ("specific_activity) which is stored on sheet("lists")

My coding is limited. Appreciate your help


Deletenotinlist()
'Updateby Extendoffice 20160930
Dim i As Long
Dim cnt As Long
Dim xWb, actWs As Worksheet
Set actWs = ThisWorkbook.ActiveSheet
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("A2:A6"), 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, "Kutools for Excel"
Else
MsgBox "Have deleted" & cnt & "worksheets"
End If
End Sub

 

[Trebor76]

Hi there,

Try this (though initially on a copy of your data as the results cannot be undone if they're not as expected):

Option Explicit
Sub Macro1()

    Dim lngMyCount As Long
    Dim lngMatch As Long
    Dim wsMySheet As Worksheet
    
    Application.ScreenUpdating = False
    
    For Each wsMySheet In ThisWorkbook.Worksheets
        On Error Resume Next
            'Delete the tab if it's name is in the 'specific_activity' name range (not case sensitive)
            lngMatch = Evaluate("MATCH(""" & wsMySheet.Name & """,specific_activity, 0)")
            If lngMatch > 0 Then
                Application.DisplayAlerts = False
                   wsMySheet.Delete
                Application.DisplayAlerts = True
                lngMyCount = lngMyCount + 1
                lngMatch = 0
            End If
        On Error GoTo 0
    Next wsMySheet
    
    Application.ScreenUpdating = True
    
    If lngMyCount = 0 Then
        MsgBox "There were no sheets deleted", vbInformation, "Kutools for Excel"
    Else
        MsgBox "Have deleted " & lngMyCount & " worksheet(s)", vbExclamation
    End If

End Sub

Regards,

Robert

 

[EEEEEE]

Awesome Robert!!! Worked perfectly. Thanks.

 

[Trebor76]

Thanks for lettings us know and you're welcome. Thanks also for the thanks and like