Needs Help With Conditional Renaming for Several Tabs

[ONG ZHEN YANG RP]

Greetings experts,

I am trying to automate renaming tasks on several tabs. Attached here is an example file with a replica of some tabs that I am working with. For some of my bigger workbooks, there will be over 100 sheets. 


For the 1st tab, the "Allocation" tab, I need to rename it as “Master_CellD28Value” which means that if Cell D28’s value is A123 - FIFO, the tab should be renamed to “Master_A123 - FIFO”.

For the 6th and 7th tab, the "ESD Trf Qty" and "EVNL Trf Qty" tabs, I need 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”

The tabs which are named "By Ctrn-EIN", "By Ctrn-EMSB", "By Ctrn-ETH", "By Ctrn-EPC" and "By Ctry-IDC", these need to be renamed 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”

As an error proofing method, the last tab, the subset list should be left alone.

I am also planning to embed this script in a command button for a userform so I hope that someone can help to advise me on an “On Error” part of the entire code.

I know that this is a very long and hard request so any help is much appreciated :)

[#2]

Hi everyone! I have did most of the work myself but I need help with some editing. For example, I need to manually key in the command for ESD Trf Qty tab then it will know it must rename it to "ESD_" & ws.Range("C28").Value

I need help creating an array or editing it such that it knows that it has to rename all tabs which has  " Trf Qty" at the back this way ". 

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
Set ws = getWorkSheet("By Ctrn-EIN")
If Not ws Is Nothing Then
renameWorkSheet ws, ws.Range("E28").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

[#3 · Accepted solution]

Hi everyone, I have figured it out myself.

The full code:

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