Subsequent Sheets Renamed From Cells Within Sheet 1

[Jason1H]

Good Day All,

I am working on project estimating workbook. I have currently have 12 worksheets within this file. First sheet is labelled "Project Page", second sheet is labelled "Labor Break Down", subsequent sheets are default to sheet 3, sheet 4, etc..... Is there a way we can rename worksheets 3-10 based on cell data entered on the first worksheet that is labelled" Project Page". So if I enter "PKG-10" in cell A1, "PKG-20" in cell A2, "PKG-30" in cell A3 of the "Project Page. Then worksheet #3 gets relabelled to "PKG-10", worksheet #4 gets relabelled to "PKG-20", worksheet #5 get relabelled to "PKG-30" etc... The data entered into cells A1 thru A10 will vary from project to project. This relabelling will need to be automatic without the need to run a macro if possible. If macro is required, I can insert a button on the "Project Page".

Alternately is there an easier way to have the sheets rename based on cell data entered into A1-A10 of the "Project Page" with the Name Manager within the Formulas ribbon tab??

 

[Micron]

Not a formula expert by any means, but I can't imagine a formula will rename sheet tabs. IMO you will have to use code, but you can wait for another opinion I guess.
Name manager only allows you to create/edit/delete named ranges. Unless your range will be dynamic I don't see much value in it. BTW, you don't have to use a button - you can run code by using the ribbon, putting an icon in the Quick Access Toolbar, or keyboard shortcut keys. Button is probably more intuitive though, but it belongs to the sheet whereas the other options don't.

 

[johnnyL]

I am pretty sure a worksheet change event can be set up to accomplish this.

It is a macro, but a button would not be required, it monitors cell changes and runs code accordingly.

 

[Micron]

Afraid I can't see why you'd want to force a sheet change in order to run sheet renaming code in this case, but maybe I'm missing something.
This takes some liberties, given the lack of certain information, but it did work.

Sub NameSheets()
'renames sheets 3 thru 12 using A1:A10 range values
Dim Lrow As Long
Dim strMsg As String
Dim result As Integer
Dim sht As Worksheet, i As Integer, x As Integer

'LastRow = .Cells(.Rows.Count, "A").End(xlUp).row
With Sheets("Project Page")
     Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row 'get row count of sheet names
End With

strMsg = "Project Page names list count exceeds the number " & vbCrLf
strMsg = strMsg & "of sheets available for naming." & vbCrLf & vbCrLf
strMsg = strMsg & "Click OK to proceed or Cancel to abort."

If ThisWorkbook.Sheets.Count - 2 < Lrow Then 'are there enough sheets for the names list?
     MsgBox(strMsg, vbOKCancel)
     If result = 2 Then Exit Sub
End If
i = 1 'i is for A rows with names
x = 3 'first sheet to rename is Sheet3
For Each sht In ThisWorkbook.Sheets
     If sht.Name = "Sheet" & x Then
          sht.Name = Range("A" & i)
          i = i + 1
          x = x + 1
     End If
Next

End Sub

CODE EDITED 2x.

 

[Jason1H]

Good Evening Guys,

Thanks for posting. I was messing around with some simple code tonight. It has been a while since I messed with code. It's also been a while sit I was last on and forget how to properly insert the code, sorry.

Anyway below is a very basic function of what I am after. This currently runs up until Worksheets(3).Name=Worksheets("Man Hours").Range("K1"). At which point I get I a Run-time Error "1004': Application-defined or object-defined error. When I cancel the debugger after each step, the subsequent worksheet names change based on the values listed in A1, K1, U1 etc...

Can someone give some insight as to what punctuation is missing or if there is a better way to lay out this code??

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Worksheets("Man Hours").Range("A1,K1,U1,AE1,AO1")) Is Nothing Then

If Worksheets("Man Hours").Range("A1,K1,U1,AE1,AO1") = Empty Then
Worksheets(2).Name = "BOM #1"
Worksheets(3).Name = "BOM #2"
Worksheets(4).Name = "BOM #3"
Worksheets(5).Name = "BOM #4"
Worksheets(6).Name = "BOM #5"
Else
Worksheets(2).Name = Worksheets("Man Hours").Range("A1")
Worksheets(3).Name = Worksheets("Man Hours").Range("K1")
Worksheets(4).Name = Worksheets("Man Hours").Range("U1")
Worksheets(5).Name = Worksheets("Man Hours").Range("AE1")
Worksheets(6).Name = Worksheets("Man Hours").Range("AO1")
End If

End If
End Sub

The reason I am having the worksheets change their names is so that I am able to track material easier for each aspect of project scope.

 

[Jason1H]

Forgot to mention that I will need to remain flexible with sheet count. I currently have 10 subsequent sheets after the "Man Hours" sheet. However, I do not foresee the need to be adding more sheets at this time.

 

[johnnyL]

.... Is there a way we can rename worksheets 3-10 based on cell data entered on the first worksheet that is labelled" Project Page". So if I enter "PKG-10" in cell A1, "PKG-20" in cell A2, "PKG-30" in cell A3 of the "Project Page. Then worksheet #3 gets relabelled to "PKG-10", worksheet #4 gets relabelled to "PKG-20", worksheet #5 get relabelled to "PKG-30" etc... The data entered into cells A1 thru A10 will vary from project to project. This relabelling will need to be automatic without the need to run a macro if possible.

I am pretty sure a worksheet change event can be set up to accomplish this.

It is a macro, but a button would not be required, it monitors cell changes and runs code accordingly.

This is about as simple as I could make it with an additional check to verify that the sheet to be renamed does exist:

Private Sub Worksheet_Change(ByVal Target As Range)
'
    Dim x   As Long
    Dim WS  As Worksheet
'
    If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub  ' If cell that was changed on the sheet is not in the range of A1:A10 then Exit this subroutine
'
    Application.EnableEvents = False                                ' Turn EnableEvents off to prevent possible endless looping of code
'
    For x = 1 To 10                                                 ' Loop through range of A1:A10
        If Not Intersect(Target, Range("A" & x)) Is Nothing Then    '   If the changed cell in range A1:A10 is found then ...
            On Error Resume Next                                    '       Turn Excel error handling off, if error found in line of code ... proceed to next line of code
'
            Set WS = ThisWorkbook.Sheets(x + 2)                     '       See if the sheet to rename exists
'
            On Error GoTo 0                                         '       Return error handling back over to Excel
'
            If Not WS Is Nothing Then                               '       If no error, then the sheet name does exist so ...
                Sheets(x + 2).Name = Range("A" & x)                 '           Change the sheet name
                Exit For                                            '           Exit the loop
            End If
        End If
    Next                                                            ' Loop back
'
    Application.EnableEvents = True                                 ' Turn EnableEvents back on
End Sub

 

[johnnyL]

Afraid I can't see why you'd want to force a sheet change in order to run sheet renaming code in this case, but maybe I'm missing something.
This takes some liberties, given the lack of certain information, but it did work.

Sub NameSheets()
'renames sheets 3 thru 12 using A1:A10 range values
Dim Lrow As Long
Dim strMsg As String
Dim result As Integer
Dim sht As Worksheet, i As Integer, x As Integer

'LastRow = .Cells(.Rows.Count, "A").End(xlUp).row
With Sheets("Project Page")
     Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row 'get row count of sheet names
End With

strMsg = "Project Page names list count exceeds the number " & vbCrLf
strMsg = strMsg & "of sheets available for naming." & vbCrLf & vbCrLf
strMsg = strMsg & "Click OK to proceed or Cancel to abort."

If ThisWorkbook.Sheets.Count - 2 < Lrow Then 'are there enough sheets for the names list?
     MsgBox(strMsg, vbOKCancel)
     If result = 2 Then Exit Sub
End If
i = 1 'i is for A rows with names
x = 3 'first sheet to rename is Sheet3
For Each sht In ThisWorkbook.Sheets
     If sht.Name = "Sheet" & x Then
          sht.Name = Range("A" & i)
          i = i + 1
          x = x + 1
     End If
Next

End Sub

CODE EDITED 2x.

@Micron
Besides the following line giving a compile error:

     MsgBox(strMsg, vbOKCancel)

Your loop of:

For Each sht In ThisWorkbook.Sheets
     If sht.Name = "Sheet" & x Then
          sht.Name = Range("A" & i)
          i = i + 1
          x = x + 1
     End If
Next

Is not correct.

 

[Micron]

compiled and worked for me when applied to what I understood was the requirement. If you're going to point out code that is "incorrect" at least say why?

 

[johnnyL]

@Micron

     MsgBox(strMsg, vbOKCancel)

Compile error:

Expected: =


Sorry for the vagueness about the 'incorrect' portion of my last post.
The For loop will only work properly if the names of the sheets are named 'Sheet3', 'Sheet4', ''Sheet5', etc.

Your subroutine would not work again, if the user wanted to change the names a second time because the code is checking for the names of the sheets instead of the codenames.

Again sorry for the vagueness in my previous post.


After looking again at your code, I see my code that I submitted also needs a correction.