Renaming Tabs from text in Worksheet

[d3319136]

We have a regular task to perform and would like to simplify it using VBA – for which we are not at all savvy with !

We have a different report name on each worksheet and would like to pull from that the next 5 characters after the word centre to become the tab name.This is in a merged cell ( always the same cell reference).

Please would someone be kind enough to provide the code which I assume I would insert as a module.

Many thanks in anticipation for support on this issue. We are using Excel 2003

 

[Jerry Sullivan]

Hello and Welcome,

If you are just renaming the ActiveSheet, you could use this:

Sub Rename_Report()
    Dim lngPos As Long
    Dim strRptName As String, strSheetName As String
    Dim strKey As String: strKey = "Centre"
    On Error GoTo ErrorHandler
    With ActiveSheet
        strRptName = .Range("A1")
        lngPos = InStr(1, strRptName, strKey, vbTextCompare)
        If lngPos > 0 Then
            strSheetName = Mid(strRptName, lngPos + 6, 5)
            .Name = strSheetName
        Else
            MsgBox "Keyword: " & strKey & " not found."
        End If
    End With
    Exit Sub
ErrorHandler:
    MsgBox "Error: Unable to create sheet " & strSheetName
End Sub

This code assumes your report name is stored in Cell A1. You can revise this to match your worksheet.

If you have many worksheets to rename, this code could be modified to rename selected worksheets or every worksheet in your workbook.

 

[d3319136]

Hi
Thank you for this - it works a treat. Within the workbook there are many sheets that also would need to be renamed. Is it easy to amend?

 

[Jerry Sullivan]

The code below should work on all worksheets in your active workbook.

I changed the error messages to display in the Immediate window in the VBA Editor so a user won't have to respond to a message box each time a sheet without the keyword "Centre" is skipped.

Sub Rename_Reports()
    Dim ws As Worksheet
    Dim lngpos As Long
    Dim strRptName As String, strSheetName As String
    Dim strKey As String: strKey = "Centre"
    On Error Resume Next
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            strRptName = .Range("A1")
            lngpos = InStr(1, strRptName, strKey, vbTextCompare)
            If lngpos > 0 Then
                strSheetName = Mid(strRptName, lngpos + 6, 5)
                If (IsError(Sheets(strSheetName).Activate)) Then
                    .Name = strSheetName
                Else
                    Debug.Print "Unable to rename Sheet " _
                        & .Name & " to " & strSheetName
                End If
            Else
                Debug.Print "On Sheet " & .Name & ", Keyword " _
                    & strKey & " not found"
            End If
        End With
    Next
End Sub

 

[d3319136]

Thank you once again - this will save hours in the course of the year.
Your time / input in doing this is much appreciated.