Solved: Delete Sheet list

[xluser2007]

Hi All,

Please find attached a sampole workbook.

In it there is a single cell-named range called SheetListStart which a starts the listing of a number of worksheets in the workbook (in this case ALL of them).

There is also a dynamic named range called CompleteSheetList which basically represents all the listing of Worksheet names starting at SheetListStart. In the corresponding column next to CompleteSheetList there is either a "Y" or "N" to delete.

Is there a nice way through VBA to delete all worksheets in the workbook that have a "Y" written next to then in CompleteSheetList?

I was hoping for a clean Select-case arrangement but am not sure how to incorporate checking for each worksheet name against the names in CompleteSheetList?

Any help appreciated,

[GTO]

Greetings,

I couldn't quite figure how to use the dynamic range you have in the name CompleteSheetList, so I just Set rngSheetNames from B2 to Bxx (last row in B w/a val).

Also, I made allowance to prevent deleting sheet that your list is on, as of course you cannot delete every sheet, and I sorta figured you wouldn't want this sheet deleted (it would seem mighty hard to find the rest of the sheets to delete if we say adios to the list).

Anyways, maybe you can modify this to work w/the named ranges.

In a Standard Module:
Sub Sheets_Del()
Dim rngSheetNames As Range
Dim rCell As Range
Dim ws As Worksheet

Set rngSheetNames = Sheet1.Range("B2:B" & Sheet1.Cells(Rows.Count, 2).End(xlUp).Row)

For Each rCell In rngSheetNames
If UCase(rCell.Offset(, 1).Value) = "Y" Then
On Error Resume Next
Set ws = Nothing
Set ws = ThisWorkbook.Worksheets(rCell.Value)
On Error Resume Next

If Not ws Is Nothing Then
If Not Sheet1.Name = ws.Name Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
End If
End If
Next
End Sub

Hope this helps,

Mark

PS - FOrgot to mention, I simply used the codename for the sheet w/the list.

[xluser2007]

Greetings,

I couldn't quite figure how to use the dynamic range you have in the name CompleteSheetList, so I just Set rngSheetNames from B2 to Bxx (last row in B w/a val).

Also, I made allowance to prevent deleting sheet that your list is on, as of course you cannot delete every sheet, and I sorta figured you wouldn't want this sheet deleted (it would seem mighty hard to find the rest of the sheets to delete if we say adios to the list).

Anyways, maybe you can modify this to work w/the named ranges.

In a Standard Module:
Sub Sheets_Del()
Dim rngSheetNames As Range
Dim rCell As Range
Dim ws As Worksheet

Set rngSheetNames = Sheet1.Range("B2:B" & Sheet1.Cells(Rows.Count, 2).End(xlUp).Row)

For Each rCell In rngSheetNames
If UCase(rCell.Offset(, 1).Value) = "N" Then
On Error Resume Next
Set ws = Nothing
Set ws = ThisWorkbook.Worksheets(rCell.Value)
On Error Resume Next

If Not ws Is Nothing Then
If Not Sheet1.Name = ws.Name Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
End If
End If
Next
End Sub
Hope this helps,

Mark

PS - FOrgot to mention, I simply used the codename for the sheet w/the list.
Hi Mark,

Many thanks as always for your great code. I have only made minor modifications as below:

Sub Sheets_Del()

Dim rngSheetNames As Excel.Range
Dim rngCell As Excel.Range
Dim wksht As Worksheet

Set rngSheetNames = ThisWorkbook.Worksheets("Sheet1").Range("CompleteSheetList")

For Each rngCell In rngSheetNames

If UCase(rngCell.Offset(, 1).Value) = "Y" Then

On Error Resume Next

Set wksht = Nothing
Set wksht = ThisWorkbook.Worksheets(rngCell.Value)

On Error Resume Next

If Not wksht Is Nothing Then

If Not rngSheetNames.Parent.Name = wksht.Name Then

Application.DisplayAlerts = False

wksht.Delete

Application.DisplayAlerts = True

End If

End If

End If

Next

End Sub
Could you please explain why the second On Error Resume Next is needed above?

Also, just for the sake of learning, I was wondering if it could be done as
follows (this is just pseudo-code)?

----------------------------------------------------------------------

For each worksheet in thisworkbook.worksheets

Select Case worksheet.name

Case Is (Any of the names in "rngSheetNames", witha "Y" next to it)

Delete

Case Is (Any of the names in "rngSheetNames", witha "N" next to it)

Don't Delete

Case Else

continue looping

Next Worksheet
----------------------------------------------------------------------


The parts in the above pseudo-code would effectively be comparing to "rngSheetList" array of names and the corresponding array of "Y" and "N".

Thanks so much for your help in the above, it is as always much appreciated. the second question is more for learning about array processing more than anything else.

I am marking the thread solved :friends:.

thanks,

[Bob Phillips]

Could you please explain why the second On Error Resume Next is needed above?

It isn't, its should be On Error Goto 0


Also, just for the sake of learning, I was wondering if it could be done as
follows (this is just pseudo-code)?

----------------------------------------------------------------------

For each worksheet in thisworkbook.worksheets

Select Case worksheet.name

Case Is (Any of the names in "rngSheetNames", witha "Y" next to it)

Delete

Case Is (Any of the names in "rngSheetNames", witha "N" next to it)

Don't Delete

Case Else

continue looping

Next Worksheet
----------------------------------------------------------------------


The parts in the above pseudo-code would effectively be comparing to "rngSheetList" array of names and the corresponding array of "Y" and "N".

I haven't tested this, but you could maybe try somethin g likje



For Each wksht In ThisWorkbook.Workssheets

rownum = 0
On Error Resume Next

rownum = Application.Match(wksht.Name, Range("rngSheetNames"), 0)
On Error GoTo 0

Select Case True

Case rownum > 0 And Cells(rownum, Range("rngSheetNames").Column + 1).Value = "Y"
Application.DisplayAlerts = False

wksht.Delete
Application.DisplayAlerts = True
End Select
Next wksht


although I am not sure what it buys you.

BTW, I saw your dynamic range definition, and I like the way you subtracted COUNTA($B$1). If anyone fills that cell in your dynamic range stays intact, good stuff.

[GTO]

It isn't, its should be On Error Goto 0

Thank you much Bob.:) How was the conference?

[xluser2007]

It isn't, its should be On Error Goto 0



I haven't tested this, but you could maybe try somethin g likje



For Each wksht In ThisWorkbook.Workssheets

rownum = 0
On Error Resume Next

rownum = Application.Match(wksht.Name, Range("rngSheetNames"), 0)
On Error GoTo 0

Select Case True

Case rownum > 0 And Cells(rownum, Range("rngSheetNames").Column + 1).Value = "Y"
Application.DisplayAlerts = False

wksht.Delete
Application.DisplayAlerts = True
End Select
Next wksht

although I am not sure what it buys you.

BTW, I saw your dynamic range definition, and I like the way you subtracted COUNTA($B$1). If anyone fills that cell in your dynamic range stays intact, good stuff.
Hi Bob,

Thanks for your help, appreciate it.

The motivation for this type of approach was that I was trying to learn how to test a worksheet name against an array of sheets names, and your Application.match is a great way indeed. I feel this way it is bit easier for someone else to understand exactly what we are doing, particulary new to VBA but familiar with functions like MATCH. Also it is nice to have an alternative method at hand.

To test, I did modify a bit as I ran into some errors and have the code below:

Sub Selected_Sheets_Delete()

Dim rngSheetNames As Excel.Range
Dim rngCell As Excel.Range
Dim wksht As Worksheet

Set rngSheetNames = ThisWorkbook.Worksheets("Sheet1").Range("CompleteSheetList")

For Each wksht In ThisWorkbook.Worksheets

rownum = 0

On Error Resume Next

rownum = Application.Match(wksht.Name, Range("rngSheetNames"), 0)

On Error GoTo 0

Select Case True

Case (rownum > 0) And (UCase(Cells(rownum, rngSheetNames.Column + 1).Value) = "N") And (UCase(Cells(rownum, rngSheetNames.Column).Value) <> wksht.Name)

Application.DisplayAlerts = False

wksht.Delete

Application.DisplayAlerts = True

End Select

Next wksht

End Sub
It is throwing up a run-time error '1004';

Application defined object error in the bold line above.

I believe the reason is because it is finding rownum = 0, when it gets to that line.

Could you please assist in debugging this?

[Bob Phillips]

Sub Selected_Sheets_Delete()
Dim rngSheetNames As Excel.Range
Dim rngListStart As Excel.Range
Dim rngCell As Excel.Range
Dim wksht As Worksheet
Dim RowNum As Long

Set rngSheetNames = ThisWorkbook.Worksheets("Sheet1").Range("CompleteSheetList")
Set rngListStart = ThisWorkbook.Worksheets("Sheet1").Range("SheetListStart")

For Each wksht In ThisWorkbook.Worksheets

RowNum = 0
On Error Resume Next

RowNum = Application.Match(wksht.Name, rngSheetNames, 0)
On Error GoTo 0

If RowNum > 0 Then

RowNum = RowNum + rngListStart.Row - 1
Select Case True

Case UCase(Cells(RowNum, rngSheetNames.Column + 1).Value) = "N" _
And UCase(Cells(RowNum, rngSheetNames.Column).Value) <> wksht.Name

Application.DisplayAlerts = False

wksht.Delete
Application.DisplayAlerts = True
End Select
End If
Next wksht

End Sub

[xluser2007]

Sub Selected_Sheets_Delete()
Dim rngSheetNames As Excel.Range
Dim rngListStart As Excel.Range
Dim rngCell As Excel.Range
Dim wksht As Worksheet
Dim RowNum As Long

Set rngSheetNames = ThisWorkbook.Worksheets("Sheet1").Range("CompleteSheetList")
Set rngListStart = ThisWorkbook.Worksheets("Sheet1").Range("SheetListStart")

For Each wksht In ThisWorkbook.Worksheets

RowNum = 0
On Error Resume Next

RowNum = Application.Match(wksht.Name, rngSheetNames, 0)
On Error GoTo 0

If RowNum > 0 Then

RowNum = RowNum + rngListStart.Row - 1
Select Case True

Case UCase(Cells(RowNum, rngSheetNames.Column + 1).Value) = "N" _
And UCase(Cells(RowNum, rngSheetNames.Column).Value) <> wksht.Name

Application.DisplayAlerts = False

wksht.Delete
Application.DisplayAlerts = True
End Select
End If
Next wksht

End Sub


many thanks Bob, I just made the slightest of changes:


Sub Selected_Sheets_Delete()

Dim rngSheetNames As Excel.Range
Dim rngListStart As Excel.Range
Dim rngCell As Excel.Range
Dim wksht As Worksheet
Dim RowNum As Long

Set rngSheetNames = ThisWorkbook.Worksheets("Sheet1").Range("CompleteSheetList")
Set rngListStart = ThisWorkbook.Worksheets("Sheet1").Range("SheetListStart")
Debug.Print rngListStart.Parent.Name

For Each wksht In ThisWorkbook.Worksheets

RowNum = 0
On Error Resume Next

RowNum = Application.Match(wksht.Name, rngSheetNames, 0)
On Error GoTo 0

If RowNum > 0 Then

RowNum = RowNum + rngListStart.Row - 1
Select Case True

Case UCase(Cells(RowNum, rngSheetNames.Column + 1).Value) = "N" _
And UCase(Cells(RowNum, rngSheetNames.Column).Value) <> UCase(rngListStart.Parent.Name)

Application.DisplayAlerts = False

wksht.Delete

Application.DisplayAlerts = True

End Select

End If

Next wksht

End Sub


It works a treat!

Thanks Mark and Bob for your help in this thread.