Renaming Worksheets

[jarvisaurus]

I have a code to rename worksheets based on a cell value but I would like to rename subsequent sheets the next unique value.

First sheet equals APPLES, then BANANAS...so forth


APPLES
APPLES
APPLES
BANANA
BANANA
BANANA

Sub RWS()
 
 
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
 
If Worksheets(i).Range("A2").Value <> "" Then
Sheets(i).Name = Worksheets(i).Range("A2").Value
 
End If
Next
End Sub

I tried Offset to no avail...the current code goes on error renaming the subsequent worksheets "APPLES"

Thanks in advance.

 

[VoG]

/PHP]I tried Offset to no avail...the current code goes on error renaming the subsequent worksheets "APPLES"/QUOTE]

No it cannot possibly do that - it would error. Try adding

Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

then test for the existence of a name

if not worksheetexists(name) then activesheet.name=nane

 

[jarvisaurus]

I received a compile error:

"ByRef argument type mismatch" on

If Not WorksheetExists(Name) Then ActiveSheet.Name = Name

I'm not too vba savvy...I added the function before the subroutine. Then added the above to the subroutine. Is that correct?

 

[VoG]

Try this

Sub RWS()
Dim i As Long, j As Long, LR As Long
LR = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To Sheets.Count
    j = j + 1
    Do While WorksheetExists(Sheets(1).Range("A" & j).Value)
        j = j + 1
        If j > LR Then Exit Sub
    Loop
    Sheets(i).Name = Sheets(1).Range("A" & j).Value
Next i
End Sub

Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

 

[jarvisaurus]

That's perfect! Thank you! =)