Forum

Dynamically rename ...
 
Notifications
Clear all

Dynamically rename sheet names when master sheet is updated

23 Posts
3 Users
0 Reactions
713 Views
(@keebellah)
Posts: 373
Reputable Member
 

Play with this one

 
Posted : 11/11/2024 7:20 am
(@donaldson7)
Posts: 10
Active Member
Topic starter
 

Hans,

I am not able to see the information for the file sent. I am not able to look at it all.

All I see is in the picture I attached.

error.png

 
Posted : 12/11/2024 12:59 pm
Anders Sehlstedt
(@sehlsan)
Posts: 972
Prominent Member
 

Hello,

If you right click and choose Save link as, do you get a proper file then?

Br,
Anders

 
Posted : 13/11/2024 2:35 am
(@keebellah)
Posts: 373
Reputable Member
 

You don't just click, you save attachment to your disk and then open it.

This is the macro code in that file below, you will have to either add a button to each sheet.

1. Place the macro code in a new Module

2. Add a button, name the button btn_RENAMESSHEET

3. Assign the macro to the macro named btn_RENAMESHEET_Click

4. copy this button to each required worksheet

Another adn better option is to add a button to your QAT and link that button either to btn_RENAMESHEET_Click or Rename_Selected_Sheet

That way you do not have to copy a button every time you add a new worksheet

The macro code:

Option Explicit

Public Sub btn_RENAMESHEET_Click()
Call Rename_Selected_Sheet
End Sub

Public Sub Rename_Selected_Sheet()
If Not IsDate(ActiveSheet.Range("E1")) Then Exit Sub
Call Check_and_Rename_Selected_Sheet(ActiveSheet, CDate(ActiveSheet.Range("E1")))
End Sub

Public Sub Check_and_Rename_Selected_Sheet(ws As Worksheet, newDate As Date)
Dim newName As String
Dim cTxt As String
GoSub cosmetics
newName = Format(newDate, "mmm dd") & cTxt
If check_if_worksheet_exists(newName) Then MsgBox newName & " is already present!", vbExclamation + vbOKOnly, "": Exit Sub
Application.EnableEvents = False
ws.Name = newName
Application.EnableEvents = True
Exit Sub

cosmetics:
Select Case Val(Right(Day(newDate), 1))
Case Is = 1
cTxt = "st"
Case Is = 2
cTxt = "nd"
Case Is = 3
cTxt = "rd"
Case Else
cTxt = "th"
End Select
Return
End Sub

Public Function check_if_worksheet_exists(newName As String) As Boolean
Dim wschk As Worksheet
For Each wschk In ThisWorkbook.Worksheets
If LCase(wschk.Name) = LCase(newName) Then check_if_worksheet_exists = True: Exit Function
Next wschk
check_if_worksheet_exists = False
End Function

 

 
Posted : 13/11/2024 2:48 am
(@keebellah)
Posts: 373
Reputable Member
 

Good morning Lisa,

Have you been able to test it?

 
Posted : 14/11/2024 2:44 am
(@donaldson7)
Posts: 10
Active Member
Topic starter
 

Hi Hans,

I apologize I did not have the time last night. You are a blessing to me! You have solved it! I copied the code and put it in the document and it worked! I did remove the part about cosmetics it was not needed and I formatted the date "dd-mmm". But it has been solved! This has only taken about 3 to 4 months to figure this out. Thank you very much for your help! I would like to bless you with some money for the answer and all the help is there a way I can do so?

 

Thank you,

Lisa Donaldson

 
Posted : 14/11/2024 9:00 pm
(@keebellah)
Posts: 373
Reputable Member
 

Hi Lisa,

I am very happy my solution worked for you.

Your appreciation in words and the fact that you're happy is enough for me Laugh

 
Posted : 16/11/2024 2:34 am
(@donaldson7)
Posts: 10
Active Member
Topic starter
 

Hi Hans, 

Thank you for your help!

 
Posted : 17/11/2024 2:39 am
Page 2 / 2
Share: