Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Dave Peterson Numbering Worksheets
In an earlier post from 09/08/2006 you gave me the following answer to the
following question, and it worked great. I have a workbook that adds worksheets, names them and sorts them...My sheet names are fine as they are with the cell entry...On the worksheet itself I have a cell with 'Sheet' typed in it then a blank cell named Sht_of_ , the next cell has 'of' typed in it then a blank cell named Sht_of_1...Looks something like this, Sheet_____ of _____...I want the numbering to go into these cells named Sht_of_ and Sht_of_1...So if I have 2 worksheets named DBL ARROW and DBL ARROW (2)...then worksheet DBL ARROW would have Sheet 1 of 2 and worksheet DBL ARROW (2) would have Sheet 2 of 2 if another worksheet was created later and it's name was DBL ARROW (3) then sheet DBL ARROW cells would change to Sheet 1 of 3 sheet DBL ARROW (2) cells would change to Sheet 2 of 3...and sheet DBL ARROW (3) cells would be Sheet 3 of 3. This may get you close: Option Explicit Sub testme() Dim MyNames() As String Dim myCount() As Long Dim wksCount As Long Dim wks As Worksheet Dim wCtr As Long Dim wkbk As Workbook Dim LastSpaceOpenParen As Long Dim myAdjName As String Dim res As Variant Dim TestRng As Range Dim CurNum As String Dim ShtOfName As String Set wkbk = ActiveWorkbook ShtOfName = "sht_of_" wksCount = wkbk.Worksheets.Count wCtr = 0 ReDim MyNames(1 To wksCount) ReDim myCount(1 To wksCount) For Each wks In wkbk.Worksheets If wks.Name Like "* (*)" Then 'just increment the count, 'the base name should be already in the list LastSpaceOpenParen = InStrRev(wks.Name, " (") myAdjName = Left(wks.Name, LastSpaceOpenParen - 1) res = Application.Match(myAdjName, MyNames, 0) If IsError(res) Then wCtr = wCtr + 1 MyNames(wCtr) = myAdjName Else myCount(res) = myCount(res) + 1 End If Else wCtr = wCtr + 1 MyNames(wCtr) = wks.Name myCount(wCtr) = 1 End If Next wks If wCtr = 0 Then MsgBox "somthing went horribly wrong" Exit Sub End If ReDim Preserve MyNames(1 To wCtr) ReDim Preserve myCount(1 To wCtr) 'loop again For Each wks In wkbk.Worksheets Set TestRng = Nothing On Error Resume Next Set TestRng = wks.Range(ShtOfName) On Error GoTo 0 If TestRng Is Nothing Then 'do nothing to this sheet Else If wks.Name Like "* (*)" Then LastSpaceOpenParen = InStrRev(wks.Name, " (") myAdjName = Left(wks.Name, LastSpaceOpenParen - 1) 'get rid of ()'s CurNum = Mid(wks.Name, LastSpaceOpenParen + 2) CurNum = Left(CurNum, Len(CurNum) - 1) Else myAdjName = wks.Name CurNum = 1 End If res = Application.Match(myAdjName, MyNames, 0) If IsError(res) Then MsgBox "this shouldn't happen!" Exit Sub Else wks.Range(ShtOfName).Value _ = "Sheet " & CurNum & " of " & myCount(res) End If End If Next wks End Sub Now the users have thrown me a curve and I can't figure out how to make it work. They have entered the following for a sheet name: 235 REPR TY (T4 (S) RAIL) when it runs the the code it gives me Sheet S) RAIL of 0 The new second sheet with the same name is 235 REPR TY (T4 (S) RAIL) (2) this is correct but the Sheet of is Sheet 2 of 0 any help is greatly appreciated. |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Dave Peterson...Oh no, not her again... | Excel Discussion (Misc queries) | |||
Dave Peterson...HELP!!!! | Excel Discussion (Misc queries) | |||
Dave Peterson | Excel Worksheet Functions | |||
Dave Peterson | Excel Discussion (Misc queries) | |||
To: Dave Peterson | Excel Programming |