Select/Delete Sheets

[Mark]

Hi,
I have a workbook with 7 sheets in it. I will always need Sheet1(“Controlâ€)
and only two of the remaining sheets, based upon what the User selects via a
user form. If the User selects “Fifth Gradeâ€, Sheet7, then I will need to
display the previous sheet, too (Sheet6(“Fourth Gradeâ€)). Thus, the final
workbook will contain Sheets 1, 6, and seven. The remaining sheets will be
deleted. My question is, how do I select the previous sheet and sheet1 when I
loop through the worksheets?
Thanks.
Mark

Sub Insert_Sheet_Template()
Dim sh As Worksheet
Dim grade As String
Dim tempPath As String
tempPath = Application.TemplatesPath & "GradeTemplates.xltm"
Application.ScreenUpdating = False
Application.Workbooks.Add Template:=tempPath

With EntryForm
Select Case True
Case .optGradeK
grade = "Kindergarten"
Case .optGrade1
grade = "1st Grade"
Case .optGrade2
grade = "2nd Grade"
Case .optGrade3
grade = "3rd Grade"
Case .optGrade4
grade = "4th Grade"
Case .optGrade5
grade = "5th Grade"
Case Else
End Select
End With
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> grade Then
sh.Delete
End If
Next
ActiveSheet.Name = "Fall"
' ActiveSheet.Previous.Name = "Last Spring Scores"
Application.ScreenUpdating = True
End Sub

 

[Joel]

When deleting more than one worksheet you need to move through the worksheet
from last sheet to first sheet to make sure you reach each sheet. If you
move forward and delete a sheet you end up skipping a sheet. Try these
changes.

Sub Insert_Sheet_Template()
Dim sh As Worksheet
Dim grade1 As String
Dim grade2 As String
Dim tempPath As String
tempPath = Application.TemplatesPath & "GradeTemplates.xltm"
Application.ScreenUpdating = False
Application.Workbooks.Add Template:=tempPath

With EntryForm
Select Case True
Case .optGradeK
grade1 = "Kindergarten"
Case .optGrade1
grade1 = "Kindergarten"
grade2 = "1st Grade"
Case .optGrade2
grade1 = "1st Grade"
grade2 = "2nd Grade"
Case .optGrade3
grade1 = "2nd Grade"
grade2 = "3rd Grade"
Case .optGrade4
grade1 = "3rd Grade"
grade2 = "4th Grade"
Case .optGrade5
grade1 = "4th Grade"
grade2 = "5th Grade"
Case Else
End Select
End With
For ShCount = ActiveWorkbook.Worksheets.Count To 1 Step -1
Set sh = ActiveWorkbook.Worksheets(ShCount)
If sh.Name <> grade1 Or _
sh.Name <> grade2 Then
sh.Delete
End If
Next
ActiveSheet.Name = "Fall"
' ActiveSheet.Previous.Name = "Last Spring Scores"
Application.ScreenUpdating = True
End Sub

 

[Mark]

Thanks, Joel. I'm sure that this is what I'm looking for, but it's deleting
all the sheets, regardless if it finds a match or not, until it errors out
stating that a workbook must contain at least one visible sheet. Any ideas?
Mark

 

[Dave Peterson]

You could use the position of the sheet within the workbook, but I wouldn't. If
"1st Grade" is moved all the way to the right, then it would screw everything
up.

Instead (and you may not like it), I'd change the names of the worksheets...

Kindergarten (no change)
Grade 1 (instead of 1st grade)
Grade 2 (instead of 2nd grade)
and so forth...

(I'd even use Grade 0 for kindergarten, but that doesn't look so nice.)

Then you could parse the sheet based on the option button.

===========

But since your list of sheets is pretty small, you could do something like:

Option Explicit
Sub Insert_Sheet_Template()
Dim sh As Worksheet
Dim ShToKeep As Variant
Dim tempPath As String
Dim res As Variant
Dim NewWkbk As Workbook

'don't you need the backslash in the next line???
tempPath = Application.TemplatesPath & "\" & "ShToKeepTemplates.xltm"

Application.ScreenUpdating = False

Set NewWkbk = Application.Workbooks.Add(Template:=tempPath)

With EntryForm
Select Case True
Case .optGradeK
ShToKeep = Array("control", "Kindergarten")
Case .optGrade1
ShToKeep = Array("control", "Kindergarten", "1st Grade")
Case .optGrade2
ShToKeep = Array("control", "1st Grade", "2nd Grade")
Case .optGrade3
ShToKeep = Array("control", "2nd Grade", "3rd Grade")
Case .optGrade4
ShToKeep = Array("control", "3rd Grade", "4th Grade")
Case .optGrade5
ShToKeep = Array("control", "4th Grade", "5th Grade")
Case Else
'do nothing
End Select
End With

For Each sh In NewWkbk.Worksheets
res = Application.Match(sh.Name, ShToKeep, 0)
If IsError(res) Then
'not in the array, delete it
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh

End Sub


Tested, but without the template file--just against the active workbook.

 

[Joel]

Change OR to AND

Thanks, Joel. I'm sure that this is what I'm looking for, but it's deleting
all the sheets, regardless if it finds a match or not, until it errors out
stating that a workbook must contain at least one visible sheet. Any ideas?
Mark

 

[Mark]

Thanks, Dave! That worked like a charm.
Mark

You could use the position of the sheet within the workbook, but I wouldn't. If
"1st Grade" is moved all the way to the right, then it would screw everything
up.

Instead (and you may not like it), I'd change the names of the worksheets...

Kindergarten (no change)
Grade 1 (instead of 1st grade)
Grade 2 (instead of 2nd grade)
and so forth...

(I'd even use Grade 0 for kindergarten, but that doesn't look so nice.)

Then you could parse the sheet based on the option button.

===========

But since your list of sheets is pretty small, you could do something like:

Option Explicit
Sub Insert_Sheet_Template()
Dim sh As Worksheet
Dim ShToKeep As Variant
Dim tempPath As String
Dim res As Variant
Dim NewWkbk As Workbook

'don't you need the backslash in the next line???
tempPath = Application.TemplatesPath & "\" & "ShToKeepTemplates.xltm"

Application.ScreenUpdating = False

Set NewWkbk = Application.Workbooks.Add(Template:=tempPath)

With EntryForm
Select Case True
Case .optGradeK
ShToKeep = Array("control", "Kindergarten")
Case .optGrade1
ShToKeep = Array("control", "Kindergarten", "1st Grade")
Case .optGrade2
ShToKeep = Array("control", "1st Grade", "2nd Grade")
Case .optGrade3
ShToKeep = Array("control", "2nd Grade", "3rd Grade")
Case .optGrade4
ShToKeep = Array("control", "3rd Grade", "4th Grade")
Case .optGrade5
ShToKeep = Array("control", "4th Grade", "5th Grade")
Case Else
'do nothing
End Select
End With

For Each sh In NewWkbk.Worksheets
res = Application.Match(sh.Name, ShToKeep, 0)
If IsError(res) Then
'not in the array, delete it
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh

End Sub


Tested, but without the template file--just against the active workbook.