Loop and Rename Worksheets

[Joey_Ng]

Hi,

I am trying to loop through a number of worksheets in the same workbook, look for the sheet names starting with sheet (eg, sheet1, sheet 2 etc...) and change those sheets with the value in cell B1 less first 4 characters. These sheets are actually "filtered pages" from a pivot table and each sheet has a value in B1. The code below only loop through the same activesheet but not actually doing anything. Help please.

Sub Loop_Rename()
Dim ws As Worksheets
Dim ct As Long, cr As String
cr = ActiveSheet.Range("B1").Value
ct = Len(ActiveSheet.Range("B1").Value) - 4
On Error Resume Next
For Each ws In ActiveWorkbook
If ws.name = "Sheet*" Then
ws.name = right(cr, ct).Value
Else
End If
Next ws
End Sub

 

[dmt32]

The code below only loop through the same activesheet but not actually doing anything. Help please.

If you comment out the On Error Resume Next line the debugger will report all the errors you have in your code

Dave

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub Loop_Rename()
   Dim ws As Worksheets
   Dim ct As Long, cr As String
   
   For Each ws In ActiveWorkbook
      If ws.Name = "Sheet*" Then
         cr = ws.Range("B1").Value
         ct = Len(ws.Range("B1").Value) - 4
         ws.Name = Right(cr, ct).Value
      End If
   Next ws
End Sub

 

[Joey_Ng]

If you comment out the On Error Resume Next line the debugger will report all the errors you have in your code

Dave

Thanks Dave. It came up with "compile error: Wrong number of arguments or invalid property assignment"

 

[Joey_Ng]

Hi & welcome to MrExcel.
How about

Sub Loop_Rename()
   Dim ws As Worksheets
   Dim ct As Long, cr As String
  
   For Each ws In ActiveWorkbook
      If ws.Name = "Sheet*" Then
         cr = ws.Range("B1").Value
         ct = Len(ws.Range("B1").Value) - 4
         ws.Name = Right(cr, ct).Value
      End If
   Next ws
End Sub

Thanks Fluff. This one also came up with the same "compile error: Wrong number of arguments or invalid property assignment" as per original code for "ws.Name=Right(cr,ct.Value). Any idea what this refers to?

 

[Joey_Ng]

Thanks Fluff. This one also came up with the same "compile error: Wrong number of arguments or invalid property assignment" as per original code for "ws.Name=Right(cr,ct.Value). Any idea what this refers to?

sorry... I meant ws.Name = right(cr, ct).Value with the word "right" highlighted

 

[dmt32]

Thanks Dave. It came up with "compile error: Wrong number of arguments or invalid property assignment"

Sub Loop_Rename()
    Dim ws As Worksheet
    Dim ct As Long, cr As String
   
    cr = ActiveSheet.Range("B1").Value
    ct = Len(ActiveSheet.Range("B1").Value) - 4
   
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Name = Right(cr, ct)
        Else
        End If
    Next ws
End Sub

Just looking at your code make the changes I have shown in BOLD & see if resolves

Dave

 

[Joey_Ng]

Sub Loop_Rename()
    Dim ws As Worksheet
    Dim ct As Long, cr As String
  
    cr = ActiveSheet.Range("B1").Value
    ct = Len(ActiveSheet.Range("B1").Value) - 4
  
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Name = Right(cr, ct)
        Else
        End If
    Next ws
End Sub

Just looking at your code make the changes I have shown in BOLD & see if resolves

Dave

Hi Dave,

Much appreciated for your help. Your code only successful on the first sheet then error "name already taken". Image also shows a sample of my data and what I am trying to do.

 

[dmt32]

If you are getting sheet name from EACH sheet cell B1 then follow Fluffs suggestion by placing that part of the code in the For Next Loop
or you will have to put and exit sub in the If Statement

For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Name = Right(cr, ct)
            Exit Sub
        Else
        End If

Dave

 

[Joey_Ng]

If you are getting sheet name from EACH sheet cell B1 then follow Fluffs suggestion by placing that part of the code in the For Next Loop
or you will have to put and exit sub in the If Statement

For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Name = Right(cr, ct)
            Exit Sub
        Else
        End If

Dave

Thanks for your time. Finally got a working code:
Sub Rename()
Dim ws As Worksheet
Dim ct As Long, cr As String

For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "Sheet*" Then
cr = ws.Range("B1").Value
ct = Len(ws.Range("B1").Value) - 4
ws.Name = Right(cr, ct)
Else
End If
Next ws
End Sub
Appreciate ALL for your assistance. Thank You.