Delete all non-matching sheet names

[ilyaskazi]

Workbook contain sheets as...
FARES1, FARES2, RULES1, CONDITIONS1, RULES2, CONDITIONS2, SHEET_X, ROUTING1, ROUTING1 (2)

FARES1 matches FARES2, RULES1 matches RULES2, CONDITIONS1 matches CONDITIONS2. Rest other sheets are non-matching sheets, which need to be deleted without prompt.

note: sheet may contain any names and in any nos.

msgbox=deleted sheet names and numbers of deleted sheet.

[Jacob Hilderbrand]

Try this macro:

Option Explicit

Sub DelSheets()
Dim DelSheet        As Collection
Dim i               As Long
Dim n               As Long
Dim ws              As Worksheet
Dim ws2             As Worksheet
Dim Counter         As Long
Dim Str             As String
Application.DisplayAlerts = False
Set DelSheet = New Collection
    Str = "The following sheets have been deleted:"
    For Each ws In Worksheets
        Counter = 0
        For Each ws2 In Worksheets
            If Left(ws2.Name, Len(ws2.Name) - 1) = Left(ws.Name, Len(ws.Name) - 1) Then
                Counter = Counter + 1
            End If
        Next
        If Counter = 1 Then
            DelSheet.Add ws.Name
        End If
    Next
    If DelSheet.Count > 0 Then
        For i = 1 To DelSheet.Count
            Sheets(DelSheet(i)).Delete
            Str = Str & vbNewLine & DelSheet(i)
        Next
        MsgBox Str
    End If
Application.DisplayAlerts = True
End Sub

[ilyaskazi]

Perfect.

thankyou....

[Jacob Hilderbrand]

You're Welcome

Take Care