VBA to Rename Worksheets Based on Contents in Sheet 1

[rcschmidt88]

Hello everyone,

This is my first time posting on here, and I'm very new to Excel VBA code, so I would appreciate some help. I have an Excel workbook with 7 sheets. The 1st one is a reference sheet titled Allocation, where I type in names of accounts into cells A3:A5. For the purpose of this question, lets say A3 is Red Account, A4 is Blue Account, and A5 is Yellow Account.

Here are the names I would like for the sheets:
Sheet 2: Red Account Sell Proposal
Sheet 3: Red Account Cost Basis
Sheet 4: Blue Account Sell Proposal
Sheet 5: Blue Account Cost Basis
Sheet 6: Yellow Account Sell Proposal
Sheet 7: Yellow Account Cost Basis

So basically for each account named in A3:A5, I would like 2 sheets, one for sell proposal and one for cost basis. I would like these name changes to be based on changing the text in cells A3:A5 of sheet one. So if I changed "Red Account" in cell A3 to "IRA", then I would want to change sheet 2 to "IRA Sell Proposal" and sheet 3 to "IRA Cost Basis". If you could please be specific about where to paste the VBA code as well, that would be great.

Thanks a ton!

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your "Allocation" sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Make sure that the "Dim" line of code remains at the very top. Close the code window to return to your sheet. Enter a value in A3:A5 and press the RETURN key.

Dim oldName As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target <> "" Then
        oldName = Target.Value
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    If Sheets.Count > 1 Then
        For Each ws In Sheets
            If ws.Name = oldName & " Sell Proposal" Then
                ws.Name = Target.Value & " Sell Proposal"
            ElseIf ws.Name = oldName & " Cost Basis" Then
                ws.Name = Target.Value & " Cost Basis"
            End If
        Next ws
        On Error Resume Next
        Set ws = Sheets(Target.Value & " Sell Proposal")
        'On Error GoTo 0
        If ws Is Nothing Then
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target.Value & " Sell Proposal"
        End If
        'On Error Resume Next
        Set ws = Sheets(Target.Value & " Cost Basis")
        On Error GoTo 0
        If ws Is Nothing Then
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target.Value & " Cost Basis"
        End If
    Else
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target.Value & " Sell Proposal"
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target.Value & " Cost Basis"
    End If
    Sheets("Allocation").Activate
    Application.EnableEvents = True
End Sub

 

[rcschmidt88]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your "Allocation" sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Make sure that the "Dim" line of code remains at the very top. Close the code window to return to your sheet. Enter a value in A3:A5 and press the RETURN key.

Dim oldName As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target <> "" Then
        oldName = Target.Value
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    If Sheets.Count > 1 Then
        For Each ws In Sheets
            If ws.Name = oldName & " Sell Proposal" Then
                ws.Name = Target.Value & " Sell Proposal"
            ElseIf ws.Name = oldName & " Cost Basis" Then
                ws.Name = Target.Value & " Cost Basis"
            End If
        Next ws
        On Error Resume Next
        Set ws = Sheets(Target.Value & " Sell Proposal")
        'On Error GoTo 0
        If ws Is Nothing Then
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target.Value & " Sell Proposal"
        End If
        'On Error Resume Next
        Set ws = Sheets(Target.Value & " Cost Basis")
        On Error GoTo 0
        If ws Is Nothing Then
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target.Value & " Cost Basis"
        End If
    Else
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target.Value & " Sell Proposal"
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target.Value & " Cost Basis"
    End If
    Sheets("Allocation").Activate
    Application.EnableEvents = True
End Sub

First of all, thank you for getting back to me so fast. I tried the code, and it partially worked. It changed the tabs for all the sell proposal sheets (sheets 2,4,6) but it didn't change the names of the cost basis sheets (sheets 3,5, and 7). I want it to work so that when I type "IRA" into A3, it changes sheet 2 to "IRA Sell Proposal" and sheet 3 to "IRA Cost Basis" based on that single input into A3.

 

[mumps]

I tested the macro in a dummy file and it seemed to work properly. I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[rcschmidt88]

I tested the macro in a dummy file and it seemed to work properly. I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

https://www.dropbox.com/s/o6jkjlrzl... Template (with Macros) for Sharing.xlsm?dl=0

Thank you very much. Please let me know if you figure it out.

 

[mumps]

I deleted all the "Account" sheets then I entered "Account 1", "Account 2" and "Account 3" and all the correct sheets were created. Then I changed "Account 2" to "IRA" and both "Account 2" sheets were renamed properly. I changed "Account 3" to "Test" and both "Account 3" sheets were renamed properly. So everything is working as it should. If is not working for you, please describe step by step what you are doing that leads to unwanted results.

 

[rcschmidt88]

To give more background, this file is a template. My goal is to be able to just change the account names in A3:A5 and have that change the names of the existing sheets 2-7. Sheets 2-7 already have specific contents and are referenced on sheet 1 which is why I don't want to create new sheets.

 

[mumps]

Try:

Dim oldName As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target <> "" Then
        oldName = Target.Value
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.Name = oldName & " Sell Proposal" Then
            ws.Name = Target.Value & " Sell Proposal"
        ElseIf ws.Name = oldName & " Cost Basis" Then
            ws.Name = Target.Value & " Cost Basis"
        End If
    Next ws
    Application.EnableEvents = True
End Sub

 

[rcschmidt88]

This is still only changing the sell proposal tab names. Do you know why this would be happening?

 

[mumps]

I noticed that some of your tab names have a trailing space at the end. Check the tab names and remove any trailing spaces and try the macro again.