Tab Rename Routine

[dwgnome]

I have an existing workbook with worksheet names such as 01, 02, 03 through 31. At the end I have worksheet names in this order: JUL 10SUM, JUL 10H, JUL 10S, JUL 10O and JUL 10R<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
On worksheet 01 I have user input cells for the date with the month, day, year in separate cells. For example in cell $C$58 has the text July, $D$58 as number, and $E$58 the year like 2010 as a number.<o></o>
<o></o>
Can someone provide/show a code that can rename the worksheet names described above to match the Month and Year?<o></o>
<o></o>
For example, if the date in worksheet 01 is November 15, 2011, then the worksheet names should be NOV 11SUM, NOV 11H, NOV 11S etc. This would need to be done automatically without user involvement other than changing the Month, Day and Year.<o></o>

 

[dwgnome]

Bump.

 

[dwgnome]

Bump!

 

[dwgnome]

Bump!

 

[Ruddles]

Hey, no need to shout - some of us have day jobs!

This code assumes that your month is definitely in sheet 01, cell C58 and the year is definitely in sheet 01, cell E58: if they're not, you'll need to amend the code accordingly (bits in red). Place it in your ThisWorkbook code module and it will do the business whenever the workbook opens:-

Option Explicit
Option Compare Text
 
Private Sub Workbook_Open()
 
  Dim ws As Worksheet
  Dim sNewname As String
 
  For Each ws In ThisWorkbook.Worksheets
    If NeedsRenaming(ws.Name) Then
      sNewname = UCase(Left(Sheets("[COLOR=red][B]01[/B][/COLOR]").Range("[COLOR=red][B]C58[/B][/COLOR]").Value, 3)) _
               & " " & Right(CStr(Sheets("[COLOR=red][B]01[/B][/COLOR]").Range("[COLOR=red][B]E58[/B][/COLOR]").Value), 2) _
               & Mid(ws.Name, 7)
      ws.Name = sNewname
    End If
  Next ws
 
End Sub
 
Private Function NeedsRenaming(ByVal argWS As String) As Boolean
 
  Dim iMo As Integer
  
  NeedsRenaming = False
  For iMo = 1 To 12
    If Left(argWS, 3) = Format("28/" & CStr(iMo) & "/2000", "mmm") Then
      NeedsRenaming = True
      Exit For
    End If
  Next iMo
  If Not NeedsRenaming Then Exit Function

 
  If Mid(argWS, 4, 1) <> " " Then Exit Function
 
  If Not IsNumeric(Mid(argWS, 5, 2)) Then Exit Function
 
  Select Case Mid(argWS, 7)
    Case "sum", "h", "s", "o", "r"
      NeedsRenaming = True
  End Select
 
End Function

 

[dwgnome]

Hi Ruddles,

Sorry if you thought I was shouting. I was just trying to get someone's attention. I thought typing in all caps was shouting.

Anyhow thank you for providing the code. I will try your solution and post back.

 

[Ruddles]

S'okay, only joshing! Hopefully I understood your requirement correctly. Always work in a copy of your workbook just in case!

 

[dwgnome]

Hi

I see that your solution works, but I did not realize that the changes take place only when you re-open the workbook. Unfortunatley that defeats the purpose of the renaming, for when the user changes the month/year, I need the change to occur immediately, because their are cells that rely on the tab name.

Is there a way to have the changes apply while the workbook remains open?

Also, when I open the workbook, I always get the warning that this workbook contains macros and asks if I want to run the macro or disable it. Is there a way to not have that pop up every time I open the workbook?

Thanks.

 

[Ruddles]

Is there a way to have the changes apply while the workbook remains open?

I'll look at it now...

Also, when I open the workbook, I always get the warning that this workbook contains macros and asks if I want to run the macro or disable it. Is there a way to not have that pop up every time I open the workbook?

You need to add the location from where you're opening the workbook to your trusted locations. Click the Office button > Excel Options > Trust Center > Trust Center Settings > Trusted Locations > Add New Location.

 

[Ruddles]

Clear out the code module for ThisWorkbook and place this in the code module for sheet 01. It will do the rename when any of the values in C58:E58 are changed by the user.

Option Explicit
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
  Dim ws As Worksheet
  Dim sNewname As String
  
  If Intersect(Target, Range("C58:E58")) Is Nothing Then Exit Sub
  
  For Each ws In ThisWorkbook.Worksheets
    If NeedsRenaming(ws.Name) Then
      sNewname = UCase(Left(Sheets("01").Range("C58").Value, 3)) _
               & " " & Right(CStr(Sheets("01").Range("E58").Value), 2) _
               & Mid(ws.Name, 7)
      ws.Name = sNewname
    End If
  Next ws
    
End Sub
 
Private Function NeedsRenaming(ByVal argWS As String) As Boolean
 
  Dim iMo As Integer
  
  NeedsRenaming = False
  For iMo = 1 To 12
    If Left(argWS, 3) = Format("28/" & CStr(iMo) & "/2000", "mmm") Then
      NeedsRenaming = True
      Exit For
    End If
  Next iMo
  If Not NeedsRenaming Then Exit Function
  
  If Mid(argWS, 4, 1) <> " " Then Exit Function
  
  If Not IsNumeric(Mid(argWS, 5, 2)) Then Exit Function
  
  Select Case Mid(argWS, 7)
    Case "sum", "h", "s", "o", "r"
      NeedsRenaming = True
  End Select
 
End Function