PDA

View Full Version : [SOLVED] Delete all non-matching sheet names



ilyaskazi
05-20-2005, 07:44 PM
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
05-20-2005, 08:39 PM
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
05-20-2005, 10:00 PM
Perfect.

thankyou....

Jacob Hilderbrand
05-20-2005, 11:44 PM
You're Welcome :beerchug:

Take Care