Macro to delete non-hidden sheets in XL2003

[Cunning]

Hi,
I'm trying to write a macro to delete non-hidden sheets in XL2007.
I'd like to see if I could adapt the following macro to do this.

/Code
Sub BrowseSheets()
Const nPerColumn As Long = 38 'number of items per column
Const nWidth As Long = 13 'width of each letter
Const nHeight As Long = 18 'height of each row
Const sID As String = "___SheetGoto" 'name of dialog sheet
Const kCaption As String = " Select sheet to goto"
'dialog caption
Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim cLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add
With thisDlg
.Name = sID
.Visible = xlSheetVisible
'sets variables for positioning on dialog
iBooks = 0
cCols = 0
cMaxLetters = 0
cLeft = 78
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
cLeft = cLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
cLetters = Len(CurrentSheet.Name)
If cLetters > cMaxLetters Then
cMaxLetters = cLetters
End If
iBooks = iBooks + 1
.OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5
.OptionButtons(iBooks).Text = _
ActiveWorkbook.Worksheets(iBooks).Name
TopPos = TopPos + 13
Next i
.Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24
CurrentSheet.Activate
With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) * nHeight + 10)
.Width = cLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With
.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.OptionButtons
If cb.Value = xlOn Then
ActiveWorkbook.Worksheets(cb.Caption).Select
Exit For
End If
Next cb
Else
MsgBox "Nothing selected"
End If
Application.DisplayAlerts = False
.Delete
End With
End Sub

/CODE

I can easily get it to delete sheets but it always shows my hidden sheets which causes a problem for me as a different macro uses one of the sheets as a template when creating new sheets and I don't want a user to delete this accidentally.

TIA

Cunning

 

[DonkeyOte]

Won't be able to go through all of your code... but when deleting visible sheets you must ensure 1 sheet at least remains visible. Best failsafe is to add a Dummy worksheet before deleting remaining visible sheets and ignoring the dummy sheet in the loop... you need to ensure you delete the DUMMY sheet if it existed beforehand (when you run a second time)

Dim ws As Worksheet
Application.DisplayAlerts = False
On Error Resume Next
Sheets("DUMMY").Delete
Sheets.Add
ActiveSheet.Name = "DUMMY"
For Each ws In ActiveWorkbook.Worksheets
    If ws.Visible = True And ws.Name <> "DUMMY" Then ws.Delete
Next ws
Application.DisplayAlerts = True

 

[Cunning]

Yeah it's ok. There will always be a Summary Sheet on display. Would be nice if I could stop that from being selected too but realise that might be a bit more tricky.

 

[DonkeyOte]

OK, well if that's the case your task is made simpler as you don't need the DUMMY sheet -- your permanently visible sheet handles that issue.. change SUMMARY SHEET in code below to be whatever the name is of the sheet that is to forever remain visible in your file...(put the sheet name in CAPS)

Dim ws As Worksheet
Application.DisplayAlerts = False
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
    If ws.Visible = True And UCASE(ws.Name) <> "SUMMARY SHEET" Then ws.Delete
Next ws
Application.DisplayAlerts = True

 

[Andrew Poulsom]

I amended your code to exclude hidden sheets:

Sub BrowseSheets()
    Const nPerColumn As Long = 38 'number of items per column
    Const nWidth As Long = 13 'width of each letter
    Const nHeight As Long = 18 'height of each row
    Const sID As String = "___SheetGoto" 'name of dialog sheet
    Const kCaption As String = " Select sheet to goto"
'   dialog caption
    Dim i As Long
    Dim TopPos As Long
    Dim iBooks As Long
    Dim cCols As Long
    Dim cLetters As Long
    Dim cMaxLetters As Long
    Dim cLeft As Long
    Dim thisDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim cb As OptionButton
    Application.ScreenUpdating = False
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
    End If
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.DialogSheets(sID).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Set CurrentSheet = ActiveSheet
    Set thisDlg = ActiveWorkbook.DialogSheets.Add
    With thisDlg
        .Name = sID
        .Visible = xlSheetVisible
'       sets variables for positioning on dialog
        iBooks = 0
        cCols = 0
        cMaxLetters = 0
        cLeft = 78
        TopPos = 40
        For i = 1 To ActiveWorkbook.Worksheets.Count
            If ActiveWorkbook.Worksheets(i).Visible = True Then
                If i Mod nPerColumn = 1 Then
                    cCols = cCols + 1
                    TopPos = 40
                    cLeft = cLeft + (cMaxLetters * nWidth)
                    cMaxLetters = 0
                End If
                Set CurrentSheet = ActiveWorkbook.Worksheets(i)
                cLetters = Len(CurrentSheet.Name)
                If cLetters > cMaxLetters Then
                    cMaxLetters = cLetters
                End If
                iBooks = iBooks + 1
                .OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5
                .OptionButtons(iBooks).Text = _
                ActiveWorkbook.Worksheets(iBooks).Name
                TopPos = TopPos + 13
            End If
        Next i
        .Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24
        CurrentSheet.Activate
        With .DialogFrame
            .Height = Application.Max(68, _
            Application.Min(iBooks, nPerColumn) * nHeight + 10)
            .Width = cLeft + (cMaxLetters * nWidth) + 24
            .Caption = kCaption
        End With
        .Buttons("Button 2").BringToFront
        .Buttons("Button 3").BringToFront
        Application.ScreenUpdating = True
        If .Show Then
            For Each cb In thisDlg.OptionButtons
                If cb.Value = xlOn Then
                    ActiveWorkbook.Worksheets(cb.Caption).Select
                    Exit For
                End If
            Next cb
        Else
            MsgBox "Nothing selected"
        End If
        Application.DisplayAlerts = False
        .Delete
    End With
End Sub

 

[Cunning]

That is spot on. Thanks. Should be able to complete the rest of my code now.

 

[jkharmer]

How would this be amended to delete all hidden sheets (except one which will be hidden, but must not be deleted, called "Test O2 & CO2"), leaving all visible sheets untouched?

Thanks in advance,

James