Error with VBA for naming sheet from cell

[leecavturbo]

I have a pretty standard VBA worksheet name from cell data. but every 7th worksheet or duplicate data the worksheet name references incorrect cell or even sheet!
any ideas ?
Sub tabname()
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
ws.Name = Left(ws.Cells(10, 1).Value, 31)
Next
On Error GoTo 0
End Sub

also how can this macro auto execute ? i.e i have to run this manually currently

 

[leecavturbo]

You could run it from the Open event, say every 10 seconds
This in the This Workbook module

Sub workbook_open()
Application.OnTime Now + TimeValue("00:00:10"), "shtnames"
End Sub
Sub shtnames()
Dim ws As Worksheet
On Error Resume Next
For Each ws In Worksheets
With ws
    .Name = Left(.Cells(10, 1).Value, 31)
End With
Next
End Sub

Seems a bit pointless though, if sheetnames aren't affected regularly

no errors but also not updating. ?‍

 

[leecavturbo]

ahhh. Another curveball detected.

So the G column on the 'Sat' sheet is where you want the changes to be detected? Example if G5 is changed from 'mark' to 'shaun', Sheet3 should be renamed to 'shaun'?

sorry yes

 

[johnnyL]

sorry yes

That is much easier to handle since all of the desired name changes are being done one one sheet and not individual cells on all of the sheets.

 

[johnnyL]

no errors but also not updating. ?‍

View attachment 49675

If that is the route that you want to take, the code that represents your most recent info given would be something like the following:

Sub workbook_open()
'
    Application.OnTime Now + TimeValue("00:00:10"), "shtnames"
End Sub


Sub shtnames()
'
    Dim ws As Worksheet
'
    On Error Resume Next
'
    NameRow = 3
'
    For Each ws In Worksheets
        If ws.Name <> "Sat" Then
            ws.Name = Left(Sheets("Sat").Cells(NameRow, 7).Value, 31)
            NameRow = NameRow + 1
        End If
    Next
End Sub

Test that on a copy of your workbook. I don't like the code because it is too easy to foul up the names of the sheets with that code. The code would need some additions, but I thought I would provide it to steer you closer.

One easy way to foul it up would be if the sheets were rerranged. Like I said, you can try it out on a copy, but it is not ready to sign off on as a solution.

 

[johnnyL]

hmmm, perhaps I spoke too soon, perhaps rearranging the sheets doesn't mess it up.

 

[johnnyL]

Nope, there is still some issues when sheets are moved.

 

[johnnyL]

Here is that code written to use an array:

Sub workbook_open()
'
    Application.OnTime Now + TimeValue("00:00:10"), "shtnames"
End Sub


Sub shtnames()
'
    Dim SheetNameRow    As Long
    Dim SheetNameRange  As Range
    Dim SheetNames      As Variant
    Dim WS              As Worksheet
'
    Set SheetNameRange = Sheets("Sat").Range("G3:" & Sheets("Sat").Range("G" & Sheets("Sat").Rows.Count).End(xlUp).Address)
'
    SheetNames = Application.Transpose(SheetNameRange)                                      ' pass names to array
    SheetNameRow = LBound(SheetNames)                                                       ' initialize start value of SheetNameRow
'
    For Each WS In Worksheets                                                               ' Go through each worksheet
        If WS.Name <> "Sat" Then                                                            '   If sheet name not = 'Sat' then ...
            WS.Name = Left(SheetNames(SheetNameRow), 31)                                    '       set name of sheet
            SheetNameRow = SheetNameRow + 1                                                 '       increment SheetNameRow variable
        End If
    Next WS
End Sub

 

[johnnyL]

Right click on the 'Sat' tab and select view code. In the window that pops up paste the following code:

Dim SheetToRename As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
'
    If Not Intersect(Target, Range("G3:G" & Cells(Rows.Count, "G").End(xlUp).Row)) Is Nothing Then      ' Monitor the G column for changes
'
        If Target.Value = "" Then                                                                       ' Check to see if user used the delete button on cell
            Application.EnableEvents = False                                                            '   If yes then disable events
            Application.Undo                                                                            '   rewind the value of cell
'
            SheetToRename = Target.Value                                                                '   Save the previous value of cell
'
            Application.Undo                                                                            '   return the cell value to current status
            Application.EnableEvents = True                                                             '   enable events
            Exit Sub                                                                                    '   return back to sheet
        Else                                                                                            ' Else
            If SheetToRename = vbNullString Then                                                        '   Check to see if we have saved a sheet name
                Application.EnableEvents = False                                                        '       if not then disable events
                Application.Undo                                                                        '       rewind the value of cell
'
                SheetToRename = Target.Value                                                            '       Save the previous value of cell
'
                Application.Undo                                                                        '       return the cell value to current status
                Application.EnableEvents = True                                                         '       enable events
            End If
        End If
'
        On Error Resume Next
'
        Sheets(SheetToRename).Name = Target.Value                                                       ' Rename the desired sheet to new name that was entered
        SheetToRename = vbNullString                                                                    ' Delete the saved sheet name
    End If
End Sub

That should handle your sheet name changes properly.

 

[leecavturbo]

Thank you very much Johnny

 

[johnnyL]

You are welcome @leecavturbo. Let us know how it goes.