PDA

View Full Version : [SOLVED] Needs Help With Conditional Renaming for Several Tabs



ham123
03-27-2019, 03:56 AM
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:23954


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! https://www.excelforum.com/images/smilies/smile.gif

大灰狼1976
03-27-2019, 07:06 PM
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
03-27-2019, 08:30 PM
Hi, thank you for your reply! :)
I have managed to create the final solution. How can I mark your comment as the solution?

ham123
03-27-2019, 09:27 PM
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
03-27-2019, 09:33 PM
Please refer to the attachment.
Run renameSheet_Test.
I wrote notes in the code.

ham123
03-27-2019, 11:18 PM
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
03-28-2019, 12:27 AM
"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
03-28-2019, 12:34 AM
I see.... I will take note of that :)

snb
03-28-2019, 05:43 AM
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