Needs Help With Conditional Renaming for Several Tabs

[ham123]

Greetings experts,

I have created a VBA routine which will be embedded into a command button for a Userform, however, it is not very versatile.
Here is an example file: example.xlsm

The full code:

Sub RenameWorkSheets()
Dim ws As Worksheet

'Rename Allocation
Set ws = getWorkSheet("Allocation")
If Not ws Is Nothing Then
renameWorkSheet ws, "Master_" & ws.Range("D28").Value
End If

'Rename ESD Trf Qty
Set ws = getWorkSheet("ESD Trf Qty")
If Not ws Is Nothing Then
renameWorkSheet ws, "ESD_" & ws.Range("C28").Value
End If

'Rename By Ctrn-EIN
Set ws = getWorkSheet("By Ctrn-EIN")
If Not ws Is Nothing Then
renameWorkSheet ws, ws.Range("E25").Value & ws.Range("C28").Value
End If


'Your other worksheets
End Sub

Function getWorkSheet(ByVal WorkSheetName As String) As Worksheet
On Error GoTo EH
Set getWorkSheet = Worksheets(WorkSheetName)
Exit Function
EH:
Set getWorkSheet = Nothing
End Function

Function renameWorkSheet(ByRef ws As Worksheet, ByVal NewName As String) As Boolean
On Error GoTo EH
If getWorkSheet(NewName) Is Nothing Then
ws.Name = NewName
renameWorkSheet = True
Else
'New Worksheet Name already exists
renameWorkSheet = False
End If
Exit Function
EH:
renameWorkSheet = False
End Function

In the abstract below, I am trying to rename the "ESD Trf Qty" tabs I have coded it to be renamed like this: The part before “ Trf Qty”_Cell C28’s value. For example, if EVNL Trf Qty tab’s cell C28 value is A123 - LIFO then the tab should be renamed to “EVNL_A123 - LIFO”. However, it is not the most versatile, as I would need to add a similar paragraph of code for all tabs and there could be hundreds of tabs. I want the code to recognize all tabs which end with " Trf Qty" to be renamed like that.

'Rename ESD Trf Qty
Set ws = getWorkSheet("ESD Trf Qty")
If Not ws Is Nothing Then
renameWorkSheet ws, "ESD_" & ws.Range("C28").Value
End If

Similarly, I also want to make this part more versatile. For the tabs which are named "By Ctrn-EIN" I rename it to “CellE25Value_CellC28Value”. If Cell E25 Value’s is Canada and Cell C28’s Value is B987 -123 then the tab should be renamed to “Canada_B987 - 123” I want the code to recognize all tabs which start with "By CTRN-" to be renamed like that.

'Rename By Ctrn-EIN
Set ws = getWorkSheet("By Ctrn-EIN")
If Not ws Is Nothing Then
renameWorkSheet ws, ws.Range("E25").Value & ws.Range("C28").Value
End If

Any help is much appreciated!

 

[Marc L]

I want the code to recognize all tabs which start with "By CTRN-" to be renamed like that.

Hi !

As a beginner starter :​

Sub Demo1()
       Const PR = "By Ctrn-"
         Dim Ws As Worksheet
    For Each Ws In ThisWorkbook.Worksheets
          If Ws.Name Like PR & "*" Then Ws.Name = PR & Ws.[C28].Text
    Next
End Sub

 

[ham123]

Hi, thank you for your reply!

I am actually trying to do it this way

Option Explicit


Sub RenameWorksheets()

    Const sPREFIX_CTRN  As String = "By CTRN-"
    Const sSUFFIX_TRF   As String = "Trf Qty"

    Dim wks             As Worksheet

    For Each wks In ThisWorkbook.Worksheets

        If UCase(Right$(wks.Name, Len(sSUFFIX_TRF))) = UCase(sSUFFIX_TRF) Then
            wks.Name = "ESD_" & wks.Range("C28").Value
        End If

        If UCase(Left$(wks.Name, Len(sPREFIX_CTRN))) = UCase(sPREFIX_CTRN) Then
            wks.Name = wks.Range("E25").Value & wks.Range("C28").Value
        End If

    Next wks

End Sub

However, the code is showing run time error at this line

wks.Name = "ESD_" & wks.Range("C28").Value

This is because there are other worksheets with "Trf Qty" besides ESD_TrfQty
Is there a way to edit it such that it will know to extract the part before " Trf Qty"?

 

[Marc L]

As two worksheets can't have the same name …
​

 

[ham123]

Yes, correct. So, is there a way to edit it such that it will know how to extract the part before " Trf Qty"?

 

[ham123]

Hi, I have figured it out. How do I close this thread?

The Final Solution

Sub RenameWorkSheets()
    Dim ws As Worksheet
    Dim sh As Worksheet
    
    'Rename Allocation
    Set ws = getWorkSheet("Allocation")
    If Not ws Is Nothing Then
         renameWorkSheet ws, "Master_" & ws.Range("D28").Value
    End If
    
    'Other worksheets
    For Each sh In Worksheets
    If sh.Name Like "*Trf Qty" Then
    sh.Name = Split(sh.Name, " ")(0) & "_" & sh.[c28]
    ElseIf sh.Name Like "By Ctry*" Then
    sh.Name = sh.[e25] & "_" & sh.[c28]
    End If
    
Next sh
    
End Sub

Function getWorkSheet(ByVal WorkSheetName As String) As Worksheet
    On Error GoTo EH
    Set getWorkSheet = Worksheets(WorkSheetName)
    Exit Function
EH:
    Set getWorkSheet = Nothing
End Function

Function renameWorkSheet(ByRef ws As Worksheet, ByVal NewName As String) As Boolean
    On Error GoTo EH
    If getWorkSheet(NewName) Is Nothing Then
        ws.Name = NewName
        renameWorkSheet = True
    Else
        'New Worksheet Name already exists
        renameWorkSheet = False
    End If
    Exit Function
EH:
    renameWorkSheet = False