Solved: reset Excel sheet count?

[tpoynton]

Greetings - i have the following bit of code to delete all but the visible sheet. it works fine, but I was wondering if there is a way to set the sheetcount back to 1 as part of this.

Right now, if I have sheets named like "sheet1", "sheet2" etc all the way up to "sheet30" and I run this procedure, it starts again at number 31 after sheets 1-30 are deleted. is there a way to reset this back to the lowest possible number? restarting excel does this, but I am wondering if it can be done through VBA.

[vba]Public Sub DeleteSheets()
Dim currentSheet As String
Dim varAnswer As String
Dim wsSheet As Worksheet
Dim strName As String
currentSheet = ActiveSheet.Name

varAnswer = MsgBox("This will delete all sheets except for the sheet named '" _
+ currentSheet + "'" + (Chr(13)) + (Chr(13)) + _
"Click Yes to irreversibly erase the other sheets, or No to cancel this procedure", _
vbYesNo, "Warning - This Procedure Can Not Be Undone!")

If varAnswer = vbNo Then
Exit Sub
Else:
Application.DisplayAlerts = False

With ActiveSheet
For Each wsSheet In Worksheets
strName = wsSheet.Name

If strName <> currentSheet Then
wsSheet.Delete
End If
Next wsSheet
End With
end if
Application.DisplayAlerts = True
End Sub[/vba]

What happens is that i have other procedures which add new sheets through VBA using worksheets.add. It is not that big of a deal, but I am curious!

[austenr]

Is this what you want?


[VBA] Public Sub DeleteSheets()
Dim currentSheet As String
Dim varAnswer As String
Dim wsSheet As Worksheet
Dim strName As String
currentSheet = ActiveSheet.Name

varAnswer = MsgBox("This will delete all sheets except for the sheet named '" + _
currentSheet + "'" + (Chr(13)) + (Chr(13)) + "Click Yes to irreversibly erase " & _
"the other sheets, or No to cancel this procedure", vbYesNo, _
"Warning - This Procedure Can Not Be Undone!")

If varAnswer = vbNo Then
Exit Sub
Else:
Application.DisplayAlerts = False

With ActiveSheet
For Each wsSheet In Worksheets
strName = wsSheet.Name

If strName <> currentSheet Then
wsSheet.Delete
End If
Next wsSheet
End With
End If
ActiveSheet.Name = "Sheet1"
Application.DisplayAlerts = True
End Sub
[/VBA]

[tpoynton]

Thanks for the reply austenr, and my apologies for not being clear!

If I am not mistaken, that will set the undeleted sheet to be named "Sheet1". I dont want to change the name of the remaining sheet, but do want all future sheets that are added to start at the lowest possible number. right now, it picks up where it left off. if Excel is restarted, it goes back to using the lowest possible number - i would like to, if possible, reset that counter without restarting excel!

I am constantly amazed at how many settings there are, and I am pretty sure it is available somewhere!

[mdmackillop]

Hi both,
Can you please use line breaks in the code, or I'll need to get a second screen!

[tpoynton]

I was going to add line breaks, but someone has beat me to it!

I'll also work on creating a file to upload...

[mdmackillop]

Yeah.
I did that.
I see your problem, but I don't know if there is a "real" solution, but here's a possible workaround. It works with one error, but not two. Add the code to ThisWorkbook module.
[VBA]Private Sub Workbook_NewSheet(ByVal Sh As Object)
On Error GoTo errh
Sh.Name = "Sheet" & Sheets.Count
Exit Sub
errh:
Sh.Name = "Sheet" & Sheets.Count + 1
End Sub[/VBA]

[tpoynton]

I just saw your post, and will play with that soon. here is a demo file to tinker with...i need to take a break, but will check in again tomorrow...

THANKS!

PS - noticed the sheets.count property is read only...that may be a problem!

[geekgirlau]

Personally I never leave a sheet named "Sheet1" anyway - I prefer to use a name that tells me what's on the sheet!

[tpoynton]

attached is a solution i can live with; i was hoping to not have to go through all of my code again, but i can use search and replace to use the addsheets function instead of worksheets.add.

i'll mark as solved, but if anyone comes up with a more elegant solution, i'm all ears...

[johnske]

[vba]Option Explicit

Sub DeleteSheets()
Dim Answer As String, Sheet As Worksheet
Answer = MsgBox("This will delete all sheets except for the sheet named '" & _
ActiveSheet.Name & "'" & vbNewLine & vbNewLine & _
"Click Yes to irreversibly erase the other sheets, or No to cancel " & _
"this procedure", vbYesNo, "Warning - This Procedure Can Not Be Undone!")
If Answer = vbNo Then
Exit Sub
Else
Application.DisplayAlerts = False
For Each Sheet In Worksheets
If Sheet.Name <> ActiveSheet.Name Then Sheet.Delete
Next
Application.DisplayAlerts = True
End If
End Sub

Sub AddSheets()
Dim N As Long
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "EZA" & Sheets.Count - 1
For N = 1 To Sheets.Count
ThisWorkbook.VBProject.VBComponents(Sheets(N).CodeName).Name = "Sheet" & N
Next
End Sub[/vba]FYI, although it's possible to use the "+" symbol for concatenation, it is neither good nor accepted practice. It's best to reserve this symbol for additions only and to use the "&" symbol for concatenation. Here is what's said in the VBA Help files regarding this

Remarks

When you use the + operator, you may not be able to determine whether addition or string concatenation will occur. Use the & operator for concatenation to eliminate ambiguity and provide self-documenting code.

Also, for new lines it's better practice to use vbNewLine (or even vbCr, or vbLf, or vbCrLf) rather than Chr(13)

[Bob Phillips]

Also, for new lines it's better practice to use vbNewLine (or even vbCr, or vbLf, or vbCrLf) rather than Chr(13)

vbNewLine is best. Macs recognise vbNewLine.

[tpoynton]

THANKS - that works quite nicely! regarding my bad coding habits, I have a bunch...thanks for pointing them out as it helps me develop new and better ones!

Regarding chr(13), I looked all over to find out how to add a blank line in messageboxes and found that. It also works on Macs, but is certainly not intuitive! thanks again!

[johnske]

THANKS - that works quite nicely! regarding my bad coding habits, I have a bunch...thanks for pointing them out as it helps me develop new and better ones!

Regarding chr(13), I looked all over to find out how to add a blank line in messageboxes and found that. It also works on Macs, but is certainly not intuitive! thanks again!

Not a prob, we're all here to learn. Happy holidays!

[vmaxer]

This code re-numbers all worksheets to back-fill the empty sheet indexes when a workbook is saved.
Excel will start indexing at the next available (new) sheet index when workbook is re-opened.

I too wanted a way to re-index the worksheets so I can dynamically add/delete many worksheets within VBA. The benefit to dynamically adding and deleting sheets vs having predefined worksheets hidden is file size and time to load the workbook.

My workbook sheets contain a lot of data... each worksheet has repeated formats and code embedded. I found it best to keep one 'template' worksheet hidden, then copy it and rename the copied sheet within VBA code. The copy/rename method duplicates the code and sheet format from the template sheet while keeping the sheet count (and data file size) to a minimum.

Problem is... deleting the newly made sheets when I'm done with them makes holes in Excel's sheet indexing. The last sheet index grows and grows every time the workbook is re-open.

I wrote this solution to be executed when a workbook is saved. Tested to work OK in Excel 2003.
- It should be placed in the VBA editor's 'ThisWorkbook' object.
- This is meant to be more of a maintenance tool... and there is no error trapping in this code (feel free to add it!). All worksheets are temporally re-indexed above the highest existing sheet index, so make sure there is enough index room to do that.

The way it works:
1) Function calls when workbook was chosen to save.
2) Find the highest number sheet in your workbook.
3) Make room to renumber all sheets low, to do this... Renumber all sheets to be greater than the highest existing sheet number.
4) Now that all low sheet numbers are free - renumber them again them to start at index=1.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

'===============================================================================================
'- Renumber all sheets to back-fill empty sheet indexes before saving workbook.
'- Allows Excel to begin indexing sheets to next lowest available sheet index when re-opened.
'- Needs Tools/Reference "Microsoft Visual Basic for Applications Extensibility"
'===============================================================================================

Dim ws As Worksheet
Dim i As Integer

Dim sThisSheetCodeName As String
Dim iThisSheetNumber As Integer
Dim iMaxSheetNumber As Integer

Application.ScreenUpdating = False
    
    '1st - Find the highest sheet number
    For Each ws In ActiveWorkbook.Worksheets
        sThisSheetCodeName = ws.Parent.VBProject.VBComponents(ws.CodeName).Properties("_CodeName").Value
        iThisSheetNumber = Right(sThisSheetCodeName, Len(sThisSheetCodeName) - 5)
        If iThisSheetNumber > iMaxSheetNumber Then iMaxSheetNumber = iThisSheetNumber
    Next
    
    '2nd - Renumber all sheets to be > than highest sheet number
    i = iMaxSheetNumber + 1
    For Each ws In ActiveWorkbook.Worksheets
        i = i + 1
        ws.Parent.VBProject.VBComponents(ws.CodeName).Properties("_CodeName").Value = "Sheet" & i
    Next
        
    '3rd - Now that all sheets are > max sheet number. Renumber all sheets to start with 1
    i = 0
    For Each ws In ActiveWorkbook.Worksheets
        i = i + 1
        ws.Parent.VBProject.VBComponents(ws.CodeName).Properties("_CodeName").Value = "Sheet" & i
    Next

Application.ScreenUpdating = True

End Sub

I'm new to this message board and wanted to give back.

Credit goes to BrianB for his message on this post exposing me to the code line:
' ws.Parent.VBProject.VBComponents(ws.CodeName).Properties("_CodeName").Value '


Thanks Brian, this code line was key in finding a solution for my sheet indexing problem!