Rename Tabs of w'sheet based on cells in "Sheet1"

[mozzie789]

Hello there

I am very green when it comes to VBA and would appreciate any help in improving this code that I have taken from a previous thread.

What I would like to do is:

Rename Tabs of a worksheet based on values in cell range "A5:A28" in "Sheet1" of Workbook ("Booktest").
There may be blank cells in this range in which case I do not want a new tab/sheet created.
Values wshould be populated in the range "A5:A28" into "Sheet1" as the workbook ("Booktest") opens. I would like the new Tabs to be generated as soon as the values are populated in "Sheet1" when the Workbook ("Booktest") opens.

I tried the following (modified) code, but it didn't work (it just didn't do anything), though it did appear to work for the person for which the thread was created.

Public OldName As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then OldName = "": Exit Sub
If Not Intersect(Target, Range("A5:A28")) Is Nothing Then _
OldName = Target.Value
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("A5:A28")) Is Nothing Then Exit Sub
If OldName <> "" And Target.Value <> OldName Then
Dim Sheet As Worksheet
For Each Sheet In Worksheets
On Error GoTo ErrTrp
If Sheet.Name = OldName Then Sheet.Name = Target.Value
Next Sheet
End If
Exit Sub
ErrTrp:
If Err.Number = 1004 Then
MsgBox "There is already a sheet named '" & Target.Value & "'." & Chr(10) & _
"Please choose a name not currently being used."
Target.Value = OldName
Else
MsgBox Err.Number & ": " & Err.Description
End If
 
End Sub

Also, when the new tab/sheet is created, how do I apply the following code to each sheet that is created. In a nutshell, the code captures and appends data from "Sheet1" to the newly created tab. The catch is:
The code in line 6 :
Range("A5:E5").Copy Destination:=Sheets("Updated").Range("A" &.....
The A5:E5 reference should only apply to the newly created tab that was generated in cell "A5" of "Sheet1".

Private Sub Worksheet_Change(ByVal Target As Range)
Static t As Date, iRun As Boolean
If Not iRun Or (Now - t) * 86400 < 180 Then
iRun = True
t = Now
Range("A5:E5").Copy Destination:=Sheets("Updated").Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets("Updated").Range("F" & Rows.Count).End(xlUp).Offset(1).Value = Now
End If
End Sub

So, the newly tab created from the cell value in "A6" of "Sheet1" should have the above code in its module but use the range A6:E6.

Could someone help me in either part 1 or part 2 of my problem?

Many thanks.

 

[mozzie789]

After searching the bowels of the forum, I manged to adapt the following code to suit my needs - except for one small problem.

Every time I run the code, I get the following error message:

"Failed to rename inserted worksheet Sheet 9 to
1004 application-defined or object-defined error"

The error continues for all blank cells referenced in "A5:A28".

So I press ok and another error message comes up:
"Failed to rename inserted worksheet Sheet 10 to
1004 application-defined or object-defined error"

The code is:

Dim cell As Range
Dim newName As String, xx As String
Sub GenWStabnames2()
'Kemper Ohlmeyer based on previous code by David McRitchie
Err.Description = ""
On Error Resume Next
'--cells with numbers, including dates, will be ignored,
For Each cell In Worksheets("Sheet1").Range("a5:a28")
Sheets.Add After:=Sheets(Sheets.Count)
If Err.Description <> "" Then Exit Sub
Err.Description = ""
newName = cell.Text
ActiveSheet.Name = newName
cell.EntireRow.Copy ActiveSheet.Range("A5")
If Err.Description <> "" Then
'--failed to rename, probably sheetname already exists...
xx = MsgBox("Failed to rename inserted worksheet " & _
vbLf & _
ActiveSheet.Name & " to " & newName & vbLf & _
Err.Number & " " & Err.Description, vbOKCancel, _
"Failed to Rename Worksheet, it will be deleted:")
'--eliminate already created sheet that failed to be renamed...
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
'--check for immediate cancellation...
If xx = vbCancel Then Exit Sub
Err.Description = ""
End If
Next cell
End Sub

<BB< p>I should mention that blank cells in the range "A5:A28" continue below the first blank cell. For eg, if the first blank cell (moving from A5 towards A28) is in A15, then all cells in the range "A15:A28" will be blank cells.

I just want the code to drop the error message and continue on through the cell range and not create the tab if it finds a blank cell in the range.

How can I modify this code?

 

[mozzie789]

Just worked out how to apply "Code Tags"

After searching the bowels of the forum, I manged to adapt the following code to suit my needs - except for one small problem.

Every time I run the code, I get the following error message:

"Failed to rename inserted worksheet Sheet 9 to
1004 application-defined or object-defined error"

The error continues for all blank cells referenced in "A5:A28".

So I press ok and another error message comes up:
"Failed to rename inserted worksheet Sheet 10 to
1004 application-defined or object-defined error"

The code is:

Dim cell As Range
Dim newName As String, xx As String
Sub GenWStabnames2()
'Kemper Ohlmeyer based on previous code by David McRitchie
Err.Description = ""
On Error Resume Next
'--cells with numbers, including dates, will be ignored,
For Each cell In Worksheets("Sheet1").Range("a5:a28")
Sheets.Add After:=Sheets(Sheets.Count)
If Err.Description <> "" Then Exit Sub
Err.Description = ""
newName = cell.Text
ActiveSheet.Name = newName
cell.EntireRow.Copy ActiveSheet.Range("A5")
If Err.Description <> "" Then
'--failed to rename, probably sheetname already exists...
xx = MsgBox("Failed to rename inserted worksheet " & _
vbLf & _
ActiveSheet.Name & " to " & newName & vbLf & _
Err.Number & " " & Err.Description, vbOKCancel, _
"Failed to Rename Worksheet, it will be deleted:")
'--eliminate already created sheet that failed to be renamed...
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
'--check for immediate cancellation...
If xx = vbCancel Then Exit Sub
Err.Description = ""
End If
Next cell
End Sub

<BB< p>I should mention that blank cells in the range "A5:A28" continue below the first blank cell. For eg, if the first blank cell (moving from A5 towards A28) is in A15, then all cells in the range "A15:A28" will be blank cells.

I just want the code to drop the error message and continue on through the cell range and not create the tab if it finds a blank cell in the range.

How can I modify this code?
<!-- / message --><!-- edit note -->