1) why not stay in the original thread so any readers would see the solution
you developed associated with the problem it is designed to fix

2) why not gather your data in one or two passes. 4 loops seems excessive.

3) think the code I provided could be modified to do it in one loop (and
probably be more reliable).

--
Regards,
Tom Ogilvy


"Alasdair Stirling" <Alasdair wrote in
message ...
Thanks for the Help.

After some research I solved the problem as follows:

Sub alpha()
' Declare the variables
Dim VBComp As VBComponent, iExistCntr As Integer
Dim iNewCntr As Integer, sOldCodeName As String
Dim sNewCodeName As String
Dim sht As Worksheet, shtNewSheet As Worksheet
Dim iShtCntr As Integer
' Count the existing sht with name starting "Sheet"
iExistCntr = 0
For Each VBComp In ThisWorkbook.VBProject.VBComponents
If VBComp.Type = vbext_ct_Document Then
If Left(VBComp.Name, 5) = "Sheet" Then
iExistCntr = iExistCntr + 1
End If
End If
Next VBComp
' Add the worksheet
ThisWorkbook.Sheets.Add
' Re-count the existing sht with name starting "Sheet"
iNewCntr = 0
For Each VBComp In ThisWorkbook.VBProject.VBComponents
If VBComp.Type = vbext_ct_Document Then
If Left(VBComp.Name, 5) = "Sheet" Then
iNewCntr = iNewCntr + 1
If iNewCntr = iExistCntr + 1 Then
sOldCodeName = VBComp.Name
End If
End If
End If
Next VBComp
' Count sht that have been renamed
iShtCntr = 0
For Each sht In ThisWorkbook.Sheets
If Left(sht.CodeName, 6) = "MyCdNm" Then
iShtCntr = iShtCntr + 1
End If
Next sht
' Develop the new codename
If iShtCntr = 0 Then
sNewCodeName = "MyCdNm" & "Sheet1"
Else
sNewCodeName = "MyCdNm" & "Sheet" & iShtCntr + 1
End If
' Name the new worksheet
ThisWorkbook.VBProject.VBComponents(sOldCodeName). _
Name = sNewCodeName
End Sub

This code allows me to add new worksheets and control their order via the
codename that I assign.

I hope that it someone might find it usefull.

Regards,

Alasdair Stirling