Error with VBA for naming sheet from cell

leecavturbo

Well-known Member
Joined
Jan 4, 2008
Messages
668
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

Well-known Member
Joined
Jan 4, 2008
Messages
668
You could run it from the Open event, say every 10 seconds
This in the This Workbook module
VBA Code:
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. ?‍♂️

1635038848303.png
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

leecavturbo

Well-known Member
Joined
Jan 4, 2008
Messages
668
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

Well-known Member
Joined
Nov 7, 2011
Messages
3,801
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
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:

VBA Code:
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

Well-known Member
Joined
Nov 7, 2011
Messages
3,801
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
hmmm, perhaps I spoke too soon, perhaps rearranging the sheets doesn't mess it up.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,801
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Nope, there is still some issues when sheets are moved.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,801
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Here is that code written to use an array:

VBA Code:
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

Well-known Member
Joined
Nov 7, 2011
Messages
3,801
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Right click on the 'Sat' tab and select view code. In the window that pops up paste the following code:

VBA 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.
 

Forum statistics

Threads
1,175,456
Messages
5,897,525
Members
434,659
Latest member
Fityi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top