Rename all Worksheets in File

[snuffnchess]

Original Post - Rename all Worksheets in File
Would not allow me to post a response - getting an HTTP ERROR 500 - so creating a new post. - Nimrod1313 I hope you see this, and do not think I am being rude by not responding.


The updated code is great and does what it is supposed to do. However there are just TOO many tabs that are formatted too poorly for it to work effectively. So I am ending up needing to manually edit a large portion of the worksheet names.

I have a work around though... but need optimizing help.

I use the following to generate a listing of the WS Names

Sub ListWSNames()

Dim ob As Workbook
    Dim ws As Worksheet
    
    Set ob = ActiveWorkbook
    Set ws = Sheets.Add(Before:=Sheets(1))
    ws.Name = "Index"



    For i = 1 To ob.Sheets.Count
        ws.Cells(i, 1) = i
        ws.Cells(i, 2) = ob.Sheets(i).Name
    Next i

    With ws
         .Rows(1).Insert
         .Cells(1, 1) = "Index"
         .Cells(1, 2) = "Original"
         .Cells(1, 3) = "Updated"
         .Columns("A:C").AutoFit
         .Rows(2).Delete
    End With
End Sub

And then the following to update the WS names.

Sub replacews()
Dim ws As Worksheet
Dim owb As Workbook
Dim ows As Worksheet
Dim owslr As Long

Dim i As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set owb = ThisWorkbook
Set ows = owb.Sheets("Index")


owslr = Cells(Rows.Count, "A").End(xlUp).Row + 1




For i = 2 To owslr
    For Each ws In Worksheets
        If ws.Name, ows.Range("B" & i).Value Then ws.Name = Format(ows.Range("C" & i).Value, "yyyy-mm-dd")
            Columns.AutoFit
        End If
    Next ws
Next i

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Code works fine if there is a small number of sheets... but when dealing with 100 (and sometimes 150 different sheets, it is just sifting through EVERY worksheet non stop. I am sure there is a better way to do this... and one that would take less resources to do.

your thoughts???

 

[Jeffrey Mahoney]

Please try this

Sub replacews()
  
  Dim ws As Worksheet
  Dim owb As Workbook
  Dim ows As Worksheet
  Dim Rng As Range
  Dim Cel As Range
  
  
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.Calculation = xlCalculationManual
  
  Set owb = ThisWorkbook
  Set ows = owb.Sheets("Index")
  
  
  Set Cel = ows.Range("A2")
  Set Rng = ows.Range(Cel, Cel.Offset(10000, 0).End(xlUp))
  
  On Error Resume Next
  For Each Cel In Rng
    If Cel.Offset(0, 1).Value <> "Index" Then
      Set ws = Sheets(Cel.Offset(0, 1).Value)
      If Not ws Is Nothing Then
        ws.Name = Format(Cel.Offset(0, 2).Value, "yyyy-mm-dd")
        ws.Columns.AutoFit
      End If
    End If
  Next Cel
  On Error GoTo 0
    
    
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True

End Sub

 

[Fluff]

Would not allow me to post a response - getting an HTTP ERROR 500 - so creating a new post. - Nimrod1313 I hope you see this, and do not think I am being rude by not responding.

How would Nimrod1313 see this, as it's a totally different site?