Increment worksheet names by letter in Excel? VB VBA

[knifey]

Hi, I'm an absolute beginner at visual basic, not a programmer (an if then do specialst) and would be very grateful of any help or views you could give in answering this probem. The code below will rename the current AFPextract01 sheet to AFPextract02, then create a fresh AFPextract01 sheet. This will then increment to 02, 03, etc. with AFPextract01 always being the current sheet.

Current code:
If SheetExists("AFPextract01") Then
intResponse = MsgBox("Sheet AFPextract01 exists, this procedure will rename the existing AFPextract01 and recreate it do you wish to proceed?", vbYesNo + vbQuestion, "Proceed?")
If intResponse = vbNo Then
Exit Sub
End If
rename = False
suffix = 2
Do While rename = False
If SheetExists("AFPextract0" & suffix) Then
suffix = suffix + 1
Else
Sheets("AFPextract01").Select
Sheets("AFPextract01").Name = "AFPextract0" & suffix
rename = True
End If
Loop
End If

Still with me...? Now, some bright spark wants to have the initial sheet called AFPextractA, with the new sheet being created called AFPextractB, then C, etc. Always working off the last sheet (C then D, E etc. as current).
I found what I thought looked like a very useful bit of code on the net (code below) but I don't know how to apply it and I really don't know how it hangs together. As I said, I'm not a programmer, but I'm learning as fast as I can (12 weeks so far).

Useful code maybe?:
Function IncrementTextString(txt As String) As String
Dim L As Integer, i As Integer, c As Integer
Dim S As String
S = txt
L = Len(S)

For i = L To 1 Step -1 'go thru the string, right to left
c = Asc(Mid(S, i, 1)) 'ASCII code of the i-th character
Select Case c
Case 65 To 89, 97 To 121 'A-Y or a-y
S = Left(S, i - 1) & Chr(c + 1) & Mid(S, i + 1)
Exit For
Case 90 'Z
S = Left(S, i - 1) & "A" & Mid(S, i + 1)
Case 122 'z
S = Left(S, i - 1) & "a" & Mid(S, i + 1)
End Select
'in the last two cases, we need to continue the loop:
Next i
If i = 0 Then
IncrementTextString = String(L + 1, 65) 'grow the string
Else
IncrementTextString = S
End If
End Function



Sorry if this is a bit long, but I have more, much more!!!

 

[VulcanJedi]

this is just a one time thing right? cause after words I assume you'll just manually make the next incremented sheet? What happens after 26 or if case sensitive 52?


Tranpkp

 

[SkipVought]

How about something like this? Use a blank sheet.

Sub test()
    Dim i As Integer
    For i = 1 To 256
        Cells(i, 1).Value = Left(Cells(1, i).Address(False, False), Len(Cells(1, i).Address(False, False)) - 1)
    Next
End Sub

Skip,

_[red][/red]

 

[stevexff]

Is there an upper limit to the number of times you want to do this? How will the alphabetic numbering proceed after sheet Z (26)? Should the Z+1th (oldest) sheet get dropped off the end?

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[knifey]

Hi Steve,
The most amount of AFPextract sheets created in a day so far has been about 5 or 6, so 26 is overkill anyway.
I could code this with IF THEN DO (if A then create B, if B then create C, etc.) but I'm afraid I would be laughed out of a job if I done this!
Please help.
Thanks.

 

[stevexff]

Sub Ripple()
    Const wbPrefix As String = "AFPExtract"
    
    For i = Worksheets.Count To 1 Step -1
        If Left(Worksheets(i).Name, Len(wbPrefix)) = wbPrefix Then
            Worksheets(i).Name = wbPrefix & _
               nextLetter(Right(Worksheets(i).Name, 1))
        End If
    Next
     
End Sub

Function nextLetter(letter As String) As String
    Const letters As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    nextLetter = Mid(letters, _
       InStr(1, letters, letter, vbTextCompare) + 1, 1)
End Function

This will increment the trailing letter of any of your worksheets that are named AFPExtract*, and ignoring any others. Inserting the new sheet at the start with a name of AFPExtractA is left as an exercise for the reader...

There is probably a simpler way to say

If Left(Worksheets(i).Name, Len(wbPrefix)) = wbPrefix

but I don't know what it is.

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[knifey]

Steve, your a star. It works perfectly. Now I just need to do the create a new sheet bit before doing the increment.
Thanks,
Roy

 

[stevexff]

No. Create the new sheet after the increment; at that point you know that if you had a sheet called AFPExtractA, it has been renamed so you don't get a name clash.

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[Fenrirshowl]

Also look at CHR to return alphabet characters, "A" is where n=65, "B" when n=66 and so on. It's useful and easy if you're only using A-Z.

Fen

 

[stevexff]

There are other ways to 'increment' a letter as Fenrirshowl notes. Mine could probably benefit from some error handling, as it breaks big time if you give it a value that's out of range...

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[knifey]

Hi Fen/ Steve,
This actually works the same way round as the current code but using letters instead of numbers. With the current sheet always being incremented to the next letter and a new AFPextractA sheet being created.
What I need is some clever loop to look for AFPextractA and if it finds it it then creates a new sheet called AFPextractB, etc. This will also need to loop through looking for AFPextractA to Z as it must be the new created sheet that is incremented (as this will be the current sheet).
Any help or advise is much appreciated.
Thanks,
Roy

 

[Fenrirshowl]

See if this works for you

Sub aaa()
On Error Resume Next
mxval = 0
For Each sht In Sheets
If Left(sht.Name, 10) = "AFPextract" Then
    tmp = Right(sht.Name, Len(sht.Name) - 10)
    For x = 1 To 26
        If tmp = Chr(64 + x) Then
            If x > mxval Then mxval = x
        End If
    Next x
End If
Next sht
If mxval < 26 Then
    Sheet.Add
    ActiveSheet.Name = "AFPextract" & Chr(mxval + 1)
End If
End Sub

 

[stevexff]

Here's version 2.0, incorporating Fenrirshowl's Chr() solution, the Like operator, and with a check to give you the option to clobber AFPExtractZ if you get that far. It adds the new sheet at the front, too.

Sub Ripple()
    Const wbPref As String = "AFPExtract"
    
    For i = Worksheets.Count To 1 Step -1
    
        If Worksheets(i).Name = wbPref + "Z" Then
            If MsgBox("Do you want to delete sheet '" _
                + wbPref + "Z?", _
                vbYesNo, "Warning") = vbYes Then
                Worksheets(i).Delete
            Else
                Exit Sub
            End If
        End If
                
        If Worksheets(i).Name Like wbPref + "[A-Y]" Then
            Worksheets(i).Name = wbPref + _
                Chr(Asc(Right(Worksheets(i).Name, 1)) + 1)
        End If
        
    Next
    
    Worksheets.Add(Worksheets(1)).Name = wbPref + "A"
    
End Sub

Would be a lot cleaner if I'd left out the overwrite check, but hey, you need to protect those users from themselves...

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[knifey]

Hi Steve & Fen,
I shortened it to this as I need the B, then C sheet, etc. at the front:

If Not SheetExists(wbPref & "A") Then
Worksheets.Add(Worksheets(1)).Name = _
wbPref & "A"
End If

If SheetExists(wbPref & "A") Then
Call Ripple
End If

Sub Ripple()
Const wbPref As String = "AFPextract"
For i = Worksheets.Count To 1 Step -1
If Worksheets(i).Name Like wbPref + "[A-Y]" Then
Worksheets.Add(Worksheets(1)).Name = _
wbPref + Chr(Asc(Right(Worksheets(i).Name, 1)) + 1)
End If
Next
End Sub

But now I have a new problem. AFPextractA is created ok on the first run and AFPextractB is created ok on the second run. But I get a runtime error 1004 (cannot rename a sheet to an existing sheet) when trying to create the AFPextractC sheet.
If I then delete sheet A manually, the macro will create sheet C ok and fail on sheet D. If I then delete B manually the macro will create D ok and fail on E (etc, etc).
Any ideas guys?
Thanks,
Roy

 

[Fenrirshowl]

I can understand what you are aiming at - the latest sheets are added to the left to cut down on code (and I've not seen ... wbPref + "[A-Y]" Then... used so thanks for that)

I generally never use Worksheets(i), preferring Sheets(i) and wonder if there is an (indexing) issue with the fact that Sheets are a collection and Worksheets aren't? (I'm not 100% on this so others can argue against the point happily).

I would suggest trying sheets rather than worksheets first and then coming back to tell me I am wrong!!! If so, will have another look.

 

[SkipVought]

The Sheets collection can contain Chart or Worksheet objects.

So if you are after ONLY worksheets, use the Worksheets Collection.

Skip,

_[red][/red]

 

[Fenrirshowl]

Thanks Skip

 

[knifey]

Hi All,
I've tried with sheets and worksheets but am still getting the same error. Any ideas?
Thanks,
Roy

 

[Fenrirshowl]

Ok, it thinks you have a sheet with that name already and I can't see why. I would put in some error handling code to select the sheet with the name that is causing the error and see where it takes you.

 

[knifey]

Hi Fen,
Found it, this is the amended code below which now works perfectly. The error was in the Worksheets.Add(Worksheets(1)) bit which was always creating AFPextractA in the first position. So the next sheet to create was always B. This has now been changed to Worksheets.Add(Worksheets(i + 1).
Thanks to everyone for all your help,
Roy

If Not SheetExists(wbPref & "A") Then
Worksheets.Add(Worksheets(1)).Name = _
wbPref & "A"
Else
Call Ripple
End If

Sub Ripple()
Const wbPref As String = "AFPextract"
For i = Worksheets.Count To 1 Step -1
If Worksheets(i).Name Like wbPref + "[A-Y]" Then
Worksheets.Add(Worksheets(i + 1)).Name = _
wbPref + Chr(Asc(Right(Worksheets(i).Name, 1)) + 1)
Exit For
End If
Next
End Sub