<

Rename a list of worksheets using VBA codes with conditions

Published on
3,708 Points
708 Views
Last Modified:
Ryan Chong
CERTIFIED EXPERT
(NIV) Hebrews 10:35 So do not throw away your confidence; it will be richly rewarded.
Excel is a great tool for business and we use it very often in our daily jobs. Sometimes we have been inherited a spreadsheet with a lot of data in which it makes us difficult to search such info.

In this case, we need to think of a way to find or tag our data.

Renaming of worksheets can be done manually, but it will look like a massive task if there are a lot of worksheets to be renamed and when we need to rename it based on some conditions or values.


Today, I'm going to show how we can actually rename the worksheets based on conditions by writing some VBA codes.


Create the fundamental


Renaming the worksheet can be as easy as looking for a fixed value and then renaming it accordingly with another fixed value.


Worksheets("Sheet1").Name = "New Sheet Name"


When we are trying to rename many worksheets, we can repeat to call the codes with minimal changes:


Worksheets("Sheet1").Name = "New Sheet Name"
Worksheets("Sheet2").Name = "New Sheet Name (2)"

Note: You must be careful when you trying to rename your worksheet:


1) Make sure the worksheet name you're referring to exists in the current worksheet

2) Make sure the new worksheet name doesn't exist in the current worksheet


To better handle this, you can create a function like this:


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 NewWsName As String) As Boolean
    On Error GoTo EH
    Debug.Print ws.Name & " to " & NewWsName
    If getWorkSheet(NewName) Is Nothing Then
        ws.Name = NewWsName
        renameWorkSheet = True
    Else
        'New Worksheet Name already exists
        renameWorkSheet = False
    End If
    Exit Function
EH:
    renameWorkSheet = False
End Function

Function getWorkSheet will be used to look up if there's an existing worksheet with the name that passes to that function. In this case, this function will return a worksheet object. Of course, you can customize your own codes to return as a Boolean instead, for example, but it's all up to you how you design your code.


Function renameWorkSheet will be used to handle the rename worksheet process. First, it checks if the worksheet exists before the code proceeds to rename it.


So, we can directly implement the rename process by using code like this:

renameWorkSheet Worksheets("Sheet1"), "New Sheet Name"
renameWorkSheet Worksheets("Sheet2"), "New Sheet Name (2)"

which should rename the worksheets accordingly


So far so good, right?


Now, what we can do is to rename the worksheets based on a set of rules, by knowing or without knowing how many of worksheets in total we should be renaming.


To do that, I would think we can list out the requirements we needed, such as:


1) What to be compared, such as fixed values, or cell values, etc.

2) The comparison method, such as exact match, partial match, or match by using start with, etc.


To address the above, I have come out with a  data structure like this:


Private Enum CompareMethod
    Exact = 1
    Within = 2
    StartWith = 3
End Enum

Private Enum ReadFrom
    Cell = 1
    FixedValue = 2
End Enum

Private Type WorkSheetSettings
    CompareKey As String
    CompareMethod As CompareMethod
    ReadFrom As ReadFrom
    ReplaceWith As String
    ReadFrom2 As ReadFrom
    ReplaceWith2 As String
    JoinString As String
End Type

Enum is being used to define the possible values for our own defined type.


Type is being used to declare a user-defined type.


In addition, we would need a function getNewWsName to generate the new worksheet name based on the options given above:


Function getNewWsName(ByRef ws As Worksheet, ByRef config As WorkSheetSettings) As String
    If config.ReplaceWith <> "" Then
        If config.ReadFrom = Cell Then
            getNewWsName = ws.Range(config.ReplaceWith).Value
        Else
            getNewWsName = config.ReplaceWith
        End If
    End If
    If config.ReplaceWith2 <> "" Then
        If config.ReadFrom2 = Cell Then
            getNewWsName = getNewWsName & config.JoinString & ws.Range(config.ReplaceWith2).Value
        Else
            getNewWsName = getNewWsName & config.JoinString & config.ReplaceWith2
        End If
    End If
End Function

Now, to rename "Sheet1" to "New Sheet Name", we can implement this:


    Dim NewWsName As String
    Dim ws As Worksheet
    Dim myConfig As WorkSheetSettings
    
    myConfig.CompareKey = "Sheet1"
    myConfig.CompareMethod = Exact
    myConfig.ReadFrom = FixedValue
    myConfig.ReplaceWith = "New Sheet Name"
    
    Set ws = getWorkSheet(myConfig.CompareKey)
    If Not ws Is Nothing Then
        NewWsName = getNewWsName(ws, myConfig)
        renameWorkSheet ws, NewWsName
    End If

In the event that we would like to rename Sheet1 based on the cell value of Sheet1's cell, A1, we can implement the same by using code:


    Dim NewWsName As String
    Dim ws As Worksheet
    Dim myConfig As WorkSheetSettings
    
    myConfig.CompareKey = "Sheet1"
    myConfig.CompareMethod = Exact
    myConfig.ReadFrom = Cell
    myConfig.ReplaceWith = "A1"
   
    Set ws = getWorkSheet(myConfig.CompareKey)
    If Not ws Is Nothing Then
        NewWsName = getNewWsName(ws, myConfig)
        renameWorkSheet ws, NewWsName
    End If

To replace multiple worksheets all together, we can simply declare the WorkSheetSettings as an array with the settings, like:

    Dim NewWsName As String
    Dim ws As Worksheet
    Dim myConfig(1) As WorkSheetSettings
    
    myConfig(0).CompareKey = "Sheet1"
    myConfig(0).CompareMethod = Exact
    myConfig(0).ReadFrom = Cell
    myConfig(0).ReplaceWith = "A1"
    
    myConfig(1).CompareKey = "Sheet2"
    myConfig(1).CompareMethod = Exact
    myConfig(1).ReadFrom = FixedValue
    myConfig(1).ReplaceWith = "New Sheet Name (2)"
    
    For i = 0 To UBound(myConfig)
        Set ws = getWorkSheet(myConfig(i).CompareKey)
        If Not ws Is Nothing Then
            NewWsName = getNewWsName(ws, myConfig(i))
            renameWorkSheet ws, NewWsName
        End If
    Next

You can try exploring the possible combinations by revisiting the rules:


1) What to be compared, such as fixed values, or cell values, etc.

2) The comparison method, such as exact match, partial match, or match by using start with, etc.


Real Scenario Implementation


Based on the question posted recently: Needs Help With Conditional Renaming for Several Tabs


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.


This actually can be done by simply changing the rules and apply the code below:


Sub RenameWorkSheets()
    Dim NewWsName As String
    Dim ArrPrefix(3) As WorkSheetSettings
    
    ArrPrefix(0).CompareKey = "Allocation"
    ArrPrefix(0).CompareMethod = Exact
    ArrPrefix(0).ReadFrom = FixedValue
    ArrPrefix(0).ReplaceWith = "Master_"
    ArrPrefix(0).ReadFrom2 = Cell
    ArrPrefix(0).ReplaceWith2 = "D28"
    
    ArrPrefix(1).CompareKey = "ESD "
    ArrPrefix(1).CompareMethod = StartWith
    ArrPrefix(1).ReadFrom = FixedValue
    ArrPrefix(1).ReplaceWith = "ESD_"
    ArrPrefix(1).ReadFrom2 = Cell
    ArrPrefix(1).ReplaceWith2 = "C28"
    
    ArrPrefix(2).CompareKey = "EVNL "
    ArrPrefix(2).CompareMethod = StartWith
    ArrPrefix(2).ReadFrom = FixedValue
    ArrPrefix(2).ReplaceWith = "EVNL_"
    ArrPrefix(2).ReadFrom2 = Cell
    ArrPrefix(2).ReplaceWith2 = "C28"
    
    ArrPrefix(3).CompareKey = "By "
    ArrPrefix(3).CompareMethod = StartWith
    ArrPrefix(3).ReadFrom = Cell
    ArrPrefix(3).ReplaceWith = "E25"
    ArrPrefix(3).ReadFrom2 = Cell
    ArrPrefix(3).ReplaceWith2 = "C28"
    ArrPrefix(3).JoinString = "_"
    
    Dim ws As Worksheet
    
    For Each ws In ActiveWorkbook.Worksheets
        For i = 0 To UBound(ArrPrefix)
            Select Case ArrPrefix(i).CompareMethod
            Case CompareMethod.Exact
                If ws.Name = ArrPrefix(i).CompareKey Then
                    NewWsName = getNewWsName(ws, ArrPrefix(i))
                    renameWorkSheet ws, NewWsName
                    Exit For
                End If
            Case CompareMethod.StartWith
                If Left(ws.Name, Len(ArrPrefix(i).CompareKey)) = ArrPrefix(i).CompareKey Then
                    NewWsName = getNewWsName(ws, ArrPrefix(i))
                    renameWorkSheet ws, NewWsName
                    Exit For
                End If
            Case CompareMethod.Within
                If InStr(ws.Name, ArrPrefix(i).CompareKey) > 0 Then
                    NewWsName = getNewWsName(ws, ArrPrefix(i))
                    renameWorkSheet ws, NewWsName
                    Exit For
                End If
            End Select
        Next
    Next
End Sub


As you can see, the main code remains the same. Hence, minimal code changes are needed.


Note:

In the case you see the worksheet name is not being renamed, there could be some possibilities:


1) You provided an invalid sheet name that needs to be renamed

2) You provided an empty new sheet name

3) You provided a new sheet name that is over the limited allowed in Excel (max allowed is 31 chars)

4) You provided a new sheet name that already exists


Well, we are done! And here is the complete code to share with you all:


Private Enum CompareMethod
    Exact = 1
    Within = 2
    StartWith = 3
End Enum

Private Enum ReadFrom
    Cell = 1
    FixedValue = 2
End Enum

Private Type WorkSheetSettings
    CompareKey As String
    CompareMethod As CompareMethod
    ReadFrom As ReadFrom
    ReplaceWith As String
    ReadFrom2 As ReadFrom
    ReplaceWith2 As String
    JoinString As String
End Type

Sub RenameWorkSheets()
    Dim NewWsName As String
    Dim ArrPrefix(3) As WorkSheetSettings
   
    ArrPrefix(0).CompareKey = "Allocation"
    ArrPrefix(0).CompareMethod = Exact
    ArrPrefix(0).ReadFrom = FixedValue
    ArrPrefix(0).ReplaceWith = "Master_"
    ArrPrefix(0).ReadFrom2 = Cell
    ArrPrefix(0).ReplaceWith2 = "D28"
   
    ArrPrefix(1).CompareKey = "ESD "
    ArrPrefix(1).CompareMethod = StartWith
    ArrPrefix(1).ReadFrom = FixedValue
    ArrPrefix(1).ReplaceWith = "ESD_"
    ArrPrefix(1).ReadFrom2 = Cell
    ArrPrefix(1).ReplaceWith2 = "C28"
   
    ArrPrefix(2).CompareKey = "EVNL "
    ArrPrefix(2).CompareMethod = StartWith
    ArrPrefix(2).ReadFrom = FixedValue
    ArrPrefix(2).ReplaceWith = "EVNL_"
    ArrPrefix(2).ReadFrom2 = Cell
    ArrPrefix(2).ReplaceWith2 = "C28"
   
    ArrPrefix(3).CompareKey = "By "
    ArrPrefix(3).CompareMethod = StartWith
    ArrPrefix(3).ReadFrom = Cell
    ArrPrefix(3).ReplaceWith = "E25"
    ArrPrefix(3).ReadFrom2 = Cell
    ArrPrefix(3).ReplaceWith2 = "C28"
    ArrPrefix(3).JoinString = "_"
   
    Dim ws As Worksheet
   
    For Each ws In ActiveWorkbook.Worksheets
        For i = 0 To UBound(ArrPrefix)
            Select Case ArrPrefix(i).CompareMethod
            Case CompareMethod.Exact
                If ws.Name = ArrPrefix(i).CompareKey Then
                    NewWsName = getNewWsName(ws, ArrPrefix(i))
                    renameWorkSheet ws, NewWsName
                    Exit For
                End If
            Case CompareMethod.StartWith
                If Left(ws.Name, Len(ArrPrefix(i).CompareKey)) = ArrPrefix(i).CompareKey Then
                    NewWsName = getNewWsName(ws, ArrPrefix(i))
                    renameWorkSheet ws, NewWsName
                    Exit For
                End If
            Case CompareMethod.Within
                If InStr(ws.Name, ArrPrefix(i).CompareKey) > 0 Then
                    NewWsName = getNewWsName(ws, ArrPrefix(i))
                    renameWorkSheet ws, NewWsName
                    Exit For
                End If
            End Select
        Next
    Next
End Sub

Function getNewWsName(ByRef ws As Worksheet, ByRef config As WorkSheetSettings) As String
    If config.ReplaceWith <> "" Then
        If config.ReadFrom = Cell Then
            getNewWsName = ws.Range(config.ReplaceWith).Value
        Else
            getNewWsName = config.ReplaceWith
        End If
    End If
    If config.ReplaceWith2 <> "" Then
        If config.ReadFrom2 = Cell Then
            getNewWsName = getNewWsName & config.JoinString & ws.Range(config.ReplaceWith2).Value
        Else
            getNewWsName = getNewWsName & config.JoinString & config.ReplaceWith2
        End If
    End If
End Function

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 NewWsName As String) As Boolean
    On Error GoTo EH
    Debug.Print ws.Name & " to " & NewWsName
    If getWorkSheet(NewName) Is Nothing Then
        ws.Name = NewWsName
        renameWorkSheet = True
    Else
        'New Worksheet Name already exists
        renameWorkSheet = False
    End If
    Exit Function
EH:
    renameWorkSheet = False
End Function


What's more?


Last but not least, we can further enhance our code to include features such as:


  • Put the color options to worksheet's tab
  • Sort the worksheets according to certain orders
  • Split the content of a worksheet into multiple worksheets
  • Merge the content of worksheets into a single worksheet


This I think we can discuss that in future tutorials.


I hope you found this article useful. You are encouraged to ask questions, report any bugs or make any other comments about it below.


Note: If you need further "Support" about this topic, please consider using the Ask a Question feature of Experts Exchange. I monitor questions asked and would be pleased to provide any additional support required in questions asked in this manner, along with other EE experts...


Please do not forget to press the "Thumb's Up" button if you think this article was helpful and valuable for EE members.  It also provides me with positive feedback. Thank you!




0
Author:Ryan Chong
Ask questions about what you read
If you have a question about something within an article, you can receive help directly from the article author. Experts Exchange article authors are available to answer questions and further the discussion.
Get 7 days free