How to delete sheets using macro?

[Eric]

There is a list of sheet name under column B of sheet "Date", I would like to
delete any sheets, which name is not included within the lists and the Date
sheet cannot be deleted too. Do you have any suggestions on how to code a
macro to do it?
Thanks in advance for any suggestions
Eric

 

[Mike H]

Eric,

Try this

Sub del_sheets()
Dim ws As Worksheet
Set sht = Sheets("Date")
Dim LastRow As Long
LastRow = sht.Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set MyRange = Range("B1:B" & LastRow)
Application.DisplayAlerts = False
For Each c In MyRange
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Date" Then
If IsError(Application.Match(ws.Name, MyRange, 0)) Then
ws.Delete
End If
End If
Next
Next
Application.DisplayAlerts = True
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Eric]

There are values under column B
1 in cell B1 and 2 in cell B2,
There are sheet named under 1 and 2 too.
When I run following macro, sheet 1 and 2 are deleted, but the names are
listed under column B, do you have any suggestions on how to fix it?
Thank you very much for any suggestions
Eric

 

[Mike H]

Eric,

There are values under column B
1 in cell B1 and 2 in cell B2,
There are sheet named under 1 and 2 too.

You never told us that. Change this line so it starts in b3

Set MyRange = Range("B3:B" & LastRow)
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Mike H]

eric,

My previous post won't work. Try this instead

Note the code now contains this line

S = "Date,1,2"

This is a list of all sheets you don't want deleted in addition to the list
in column B

Sub del_sheets()
Dim ws As Worksheet
Set sht = Sheets("Date")
Dim LastRow As Long
S = "Date,1,2"
V = Split(S, ",")
LastRow = sht.Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set MyRange = Range("B1:B" & LastRow)
Application.DisplayAlerts = False
For Each c In MyRange
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, MyRange, 0)) _
And IsError(Application.Match(ws.Name, V, 0)) Then
ws.Delete
End If

Next
Next
Application.DisplayAlerts = True
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Eric]

Under column B, each cell contains any sheetname or nothing, but the name is
a variable, which can be changed based on different inputs.

For example,
The following sheets are existed as shown below:
Date, Peter, Mary, School, Apple, Car, Cup

There are names starting from cell B1 to cell B5 under Sheet 'Date' as shown
below: cell B6 to B500 are empty cell, which contain "" sign.
Peter, Mary, School, Apple, Car

Each sheet named under those names should be kept and will not be deleted,
if there is another sheet 'Cup', you do not find Cup under column B in Date
sheet, then sheet 'Cup' will be deleted.

Therefore, the following sheets will be maintained.
Date, Peter, Mary, School, Apple, Car

Do you have any suggestions on how to fix it? but not hard code those names
within macro.

Thank you very much for any suggestions
Eric

 

[Mike H]

Eric,

The code I gave you will delete any sheet that doesn't appear in the list in
Column B of sheet "Date".

In addition in your other posts you have said the number 1 & 2 are in b1 and
b2 and there are sheets of this name that you don't want deleting. My code
won't delete those sheets or the sheet called "Date"

Re-reading your latest post I think this is what you want.


--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Eric]

I have tried following code, it deletes all sheets except Date, even through,
1 in cell B1, and 2 in cell B2, sheet '1' and '2' will delete also, I don't
know why.

For example,
The following sheets are existed as shown below:
Date, 1, 2, 3

There are names starting from cell B1 to cell B2 under Sheet 'Date' as shown
below: cell B3 to B500 are empty cell, which contain "" sign.
1, 2

Each sheet named under those names should be kept and will not be deleted,
if there is another sheet 3, you do not find 3 under column B in Date
sheet, then sheet '3' will be deleted.

Therefore, the following sheets should be maintained.
Date, 1, 2, but after running following codes
only Date sheet exists, and 1 and 2 sheets are deleted.

Do you have any suggestions on how to fix it?
Thanks in advance for any suggestions
Eric

'---------------------------------------
Sub del_sheets()
Dim ws As Worksheet
Set sht = Sheets("Date")
Dim LastRow As Long
LastRow = sht.Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set MyRange = Range("B1:B" & LastRow)
Application.DisplayAlerts = False
For Each c In MyRange
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Date" Then
If IsError(Application.Match(ws.Name, MyRange, 0)) Then
ws.Delete
End If
End If
Next
Next
Application.DisplayAlerts = True
End Sub
'---------------------------------------

 

[Mike H]

Eric,

Are you sure the sheet names in Col B don't have extra spaces at the
beginning/End

If you want you can send me a copy of the workbook to the email below with
the obvious changes to the address and I'll take a look.

m(dot)L(dot)hughes at virginmedia(dot)com
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Eric]

There is the formula in cell B1, you can copy it down to B500
=IF(A1="","",ROW())

There are following codes to adding sheet.
Each sheet name is '1' without any spacing.
Do you have any suggestions?
Thank you very much for any suggestions
Eric

'---------------------------------------------------------------------
Sub AddSheet()

Dim qtEntry As QueryTable
Dim qryConnect As String
Dim anyRange As Range
Dim anySheet As Worksheet
Dim lngRow As Long, ws As Worksheet, wsDate As Worksheet

Set wsDate = Sheets("Date")
For lngRow = 1 To wsDate.Range("O1").Value

If Not SheetExists(wsDate.Range("b" & lngRow)) Then
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = wsDate.Range("b" & lngRow)
Else
Set ws = Sheets(wsDate.Range("b" & lngRow).Text)
End If

'ws.Hyperlinks.Add ws.Range("A1"), wsDate.Range("c" & lngRow), _
'TextToDisplay:=wsDate.Range("c" & lngRow).Text


Set anyRange = ws.Range("A1:" & _
ws.Range("A25").SpecialCells(xlLastCell).Address)
On Error Resume Next ' errors if no querytable entry
anyRange.QueryTable.Delete
On Error GoTo 0
anyRange.ClearContents

qryConnect = wsDate.Range("c" & lngRow).Text

With ws.QueryTables.Add(Connection:=qryConnect, Destination _
:=ws.Range("$A$1"))

On Error Resume Next
.Connection = qryConnect

For i = 1 To 5
If i = 5 Then
.Connection = qryConnect
End If

If Err.Number Then
Err.Clear
Else
Exit For
End If
Next
If i = 6 Then
Debug.Print "failed"
Else
Debug.Print i & " attempt(s) success"
End If

On Error GoTo 0

.Name = "Holidayo070104"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertEntireRows
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False

.Refresh BackgroundQuery:=False
End With
Next
Sheets("Date").Select
End Sub


Function SheetExists(strSheet As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Sheets(strSheet)
If Not ws Is Nothing Then SheetExists = True
End Function
'-----------------------------------------------------------

 

[Eric]

Do you receive my email?
I look forward to your reply
Thank you very much for any suggestions
Eric

 

[Mike H]

Hi,

Looking at you formula you will only ever have the roow number in column B.
So try this. It will keep the sheet 'date' and any sheet that appears in
column B

Sub zDel_sheets()
Dim ws As Worksheet
Set sht = Sheets("Date")
Dim LastRow As Long
LastRow = sht.Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set MyRange = Range("B1:B" & LastRow)
Application.DisplayAlerts = False
For Each c In MyRange
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Date" Then
If Not IsError(Application.Match(ws.Name, MyRange, 0)) Then
ws.Delete
End If
End If
Next
Next
Application.DisplayAlerts = True
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Mike H]

Eric,

At last I understand, try this. The problem was in comparing numbers and
strings

Sub del_sheets()
Dim DelFlag As Boolean
DelFlag = True
Dim ws As Worksheet
Set sht = Sheets("Date")
Dim LastRow As Long
LastRow = sht.Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set MyRange = sht.Range("B1:B" & LastRow)
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Date" Then
For Each d In MyRange
If CStr(d.Value) = ws.Name Then
DelFlag = False
Exit For
End If
Next
If DelFlag Then ws.Delete
End If
DelFlag = True
Next
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Eric]

Thank you very much for suggestions
Eric

Eric,

At last I understand, try this. The problem was in comparing numbers and
strings

Sub del_sheets()
Dim DelFlag As Boolean
DelFlag = True
Dim ws As Worksheet
Set sht = Sheets("Date")
Dim LastRow As Long
LastRow = sht.Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set MyRange = sht.Range("B1:B" & LastRow)
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Date" Then
For Each d In MyRange
If CStr(d.Value) = ws.Name Then
DelFlag = False
Exit For
End If
Next
If DelFlag Then ws.Delete
End If
DelFlag = True
Next
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.