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!

[大灰狼1976]

Hi ham!
Welcome to vbax forum.

Sub renameSheet_Test()
Dim sh As Worksheet
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 Ctrn*" Then
    sh.Name = sh.[e25] & "_" & sh.[c28]
  End If
Next sh
End Sub

But the attachment you provided is "By Ctry" instead of "By Ctrn"
And, It will make error when the same worksheet name.



--Okami

[ham123]

Hi, thank you for your reply!
I have managed to create the final solution. How can I mark your comment as the solution?

[ham123]

For your reference, this is my 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
End Function

[大灰狼1976]

Please refer to the attachment.
Run renameSheet_Test.
I wrote notes in the code.

[ham123]

Thank you again! For your question earlier about the "same name" problem, it was because there were the same inputs for some of the renaming. After ensuring that they were different, it worked fine

[大灰狼1976]

"Allocation" processing can also be simplified. Not need custom function "getWorkSheet" and "renameWorkSheet".
You can also use "select case" instead of "if".

Sub RenameWorkSheets()
    Dim sh As Worksheet
    'All 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]
      ElseIf sh.Name = "Allocation" Then
        sh.Name = "Master_" & sh.[D28]
      End If
    Next sh
End Sub

[ham123]

I see.... I will take note of that

[snb]

or

Sub M_snb()
  For Each it In Sheets
      If InStr("ABE", Left(it.Name, 1)) Then it.Name = Choose(InStr("ABE", Left(it.Name, 1)), "Master_" & it.Cells(28, 4), it.Cells(25, 5) & "_" & it.Cells(28, 3), "Trf_" & it.Cells(28, 3))
  Next
End Sub