Run-time error when using VBA to rename worksheets

[thomaslovell]

Please help!!!

Firstly, I am a VBA beginner. I have a Excel (2010) workbook where there are many sheets that need to be renamed according to a list of names on the first sheet named "Testing". The range of names (starting at cell A3) on the first sheet are a part of a Pivot Table. When the information in the Pivot Table is changed, I need to run the macro to change the Worksheet names automatically.

I have used the code below which was posted on another thread for someone requesting similar functionality.

While the below code seems to work fine, when the Pivot Table is updated (using a slicer) and I re-run the macro, I receive the following error message: Run-time error '1004': Application-defined or object-defined error.

Can anybody please tell me why this is happening???

Sub MakeSheetNames()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim rng1 As Range[/INDENT]
    Dim rng2 As Range
    Dim objDic
    Dim strTmp As String
    Dim strErr As String
    Dim lngCnt As Long
    Set objDic = CreateObject("scripting.dictionary")
    Set ws1 = ThisWorkbook.Sheets("Testing")
    If ws1.Index <> 1 Then
        MsgBox "This code assumes the Set-up sheet is the first worksheet, please reorder sheets and retry"
        Exit Sub
    End If
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    Set rng1 = ws1.Range(ws1.[a3], ws1.Cells(Rows.Count, "A").End(xlUp))
    lngCnt = 1
    For Each rng2 In rng1
        strTmp = CleanString(rng2.Value)
        If Len(strTmp) > 0 Then
            If Not objDic.exists(strTmp) Then
                lngCnt = lngCnt + 1
                If ThisWorkbook.Sheets.Count < lngCnt Then
                    MsgBox "You only have " & ThisWorkbook.Sheets.Count & " sheets for renaming" & vbNewLine & "Please add more sheets then rerun"
                Else
                    ThisWorkbook.Sheets(lngCnt).Name = strTmp
                    objDic.Add (strTmp), lngCnt
                End If
            Else
                strErr = strErr & strTmp & vbNewLine
            End If
        End If
    Next
    If Len(strErr) > 0 Then MsgBox "These sheets were duplicated:" & vbNewLine & strErr
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub


Function CleanString(strIn As String) As String
    With CreateObject("VBScript.RegExp")
        .Pattern = "[^A-Z\s]+"
        .Global = True
        .IgnoreCase = True
        CleanString = Application.Trim(.Replace(strIn, ""))
    End With
End Function

​

 

[thomaslovell]

Currently, each athlete's worksheet contains a chart which is linked to the values displayed in the pivot table on the "Testing" sheet. As the data in the sheets changes instantly when the pivot table is updated, it is important for the worksheet names to change also. Does this answer your question?

Thanks for your help and insight Jerry.

 

[Jerry Sullivan]

When sheets are added, what needs to be done to prepare the new sheet to have the chart and read the correct data for that athlete
(I would think that you would copy an existing sheet or template sheet and modify it somehow)

What causes the chart data to change for another athlete when the sheet name changes from NameA to NameB?

 

[thomaslovell]

When adding a new sheet, I duplicate a previous sheet and then change the Source Data for the chart.

The Chart Title is the athlete name (column A on Pivot Table) and the Chart Data is sourced from columns B-Q in the corresponding row on the Pivot Table.

 

[Jerry Sullivan]

That's the part that I'm getting at when I say that renaming the sheets is easier than the other steps (for both existing and new sheets).

For existing sheets, if you just rename the sheet, won't the chart be showing data for the previous athlete based on existing Chart Data Source?
It would seem you need to remap the Chart Data Source, either using formula based dynamic references or VBA.

I'm not implying this can't be done with VBA. It's best to set up your system so you can understand and maintain it, so for now that means keeping the VBA parts simple.

 

[thomaslovell]

Okay. My "Testing" sheet is the first sheet in the workbook. I then have a "Testing Data" sheet which supplies the data for the Pivot Table on the "Testing" sheet. The third sheet in the workbook, let's say "Sheet 3", is the first of the athlete profile sheets.

The chart data for "Sheet 3" is sourced from the first row of the Pivot Table (A4 on "Testing" sheet). Similarly, the chart data for "Sheet 4" is sourced from the second row of the Pivot Table.

Therefore if "Athlete 1" is in the first row of the Pivot Table, "Sheet 3" needs to be renamed to "Athlete 1".

Next, the Pivot Table may be altered with a Slicer. Let's say this moves "Athlete 7" to the first row of the Pivot Table. Automatically, Athlete 7's testing data will be sourced to the Chart on "Sheet 3", however it will still be named "Athlete 1".

Hopefully this explains it.

 

[Jerry Sullivan]

Here is some code that you can try to handle the renaming of the sheets.

Sub UpdateSheetNames()
'--Updates sheet names to match PivotItem list of Athletes' names.

    Dim ws1 As Worksheet, wsTemplate As Worksheet
    Dim rng1 As Range
    Dim lItemCount As Long, lSheetCount As Long
    Dim i As Integer, iName As Integer

    
    On Error GoTo CleanUp

    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

'--validate workbook setup
    With ThisWorkbook
        If Not ( _
            .Worksheets(1).Name = "Testing" And _
            .Worksheets(2).Name = "Testing Data" And _
            .Worksheets.Count > 2 And _
            .Worksheets.Count = .Sheets.Count) Then  'No Chart sheets
            MsgBox "Workbook is not setup correctly to run UpdateSheetNames macro"
            Exit Sub
        End If
    End With

'--get range listing unique PivotItems- Strings should be Letters and spaces only
    Set ws1 = ThisWorkbook.Sheets("Testing")
    Set rng1 = ws1.Range(ws1.[a4], ws1.Cells(Rows.Count, "A").End(xlUp))
    lItemCount = rng1.Count
    If lItemCount < 0 Or lItemCount = 1 And [a4] = "" Then Exit Sub

 
'--add or remove sheets to match the number of Athletes' reports after 2 front sheets
    lSheetCount = ThisWorkbook.Worksheets.Count - 2
    If lSheetCount > lItemCount Then
        '--delete extra sheets
        For i = lSheetCount To lItemCount + 1 Step -1
            ThisWorkbook.Worksheets(i + 2).Delete
        Next i

 
    ElseIf lSheetCount < lItemCount Then
        '--add worksheets by copying from template
        Set wsTemplate = ThisWorkbook.Worksheets(3)
        With ThisWorkbook
            For i = 1 To lItemCount - lSheetCount
                wsTemplate.Copy After:=.Worksheets(.Worksheets.Count)
                '***Optional add index number for Chart Source Data dynamic reference
                ActiveSheet.[g1].Value = i
            Next i
        End With
    End If

'--rename sheets with temporary names
    With ThisWorkbook
        For i = 3 To .Worksheets.Count - 2
            .Worksheets(i).Name = "TempName" & i - 2
        Next i
    End With

'--rename sheets from PivotItem List
    With ThisWorkbook
        For iName = 1 To lItemCount
            .Worksheets(iName + 2).Name = rng1(iName).Value
        Next iName
    End With

CleanUp:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    If Err.Description = "Application-defined or object-defined error" And iName > 0 Then
        MsgBox "Unable to rename sheet to: " & rng1(iName).Value, vbExclamation, "Macro stopped"
    End If
    
    Set ws1 = Nothing
    Set wsTemplate = Nothing
    Set rng1 = Nothing

End Sub

The approach is to use the 3rd worksheet in the workbook (the first athlete profile) as a template and add copies when the number of items exceeds the existing profile sheets.

That still leaves you with the need to map the Chart Source Data to the corresponding row of data for any sheets that are added.

I added a line of code that places the pivot table row number to G1 of each added sheet.
You could using that to make a dynamic reference to your Chart Source Data in lieu of more complex VBA.

                '***Optional add index number for Chart Source Data dynamic reference
                ActiveSheet.[g1].Value = i

 

[thomaslovell]

Thanks Jerry. I really appreciate the time you have taken to send me this code.

Can you please explain the 'validate workbook setup' step of this code.

I have tried to run the macro however I receive the "workbook not setup correctly" message.

The first two worksheets are setup as they should - sheet 1 "Testing" and sheet 2 "Testing Data".

What are the second two steps checking for?

 

[Jerry Sullivan]

The other two checks are that there are at least three worksheets (so the third worksheet can be copied); and lastly that the number of worksheets equals the number of sheets. This last criterion was to avoid the complexity of sorting out chart sheets from worksheets.

Do you have chart sheets in your workbook? By that I don't mean worksheets with embedded charts but rather entire sheets that are charts?

 

[thomaslovell]

Sorry for the miscommunication. All of the athlete profile sheets are 'Chart Sheets'.

Should I just remove this last criterion?

 

[Jerry Sullivan]

No problem. It will take a few more adjustments than just removing the last criterion, since the references are to Worksheet Objects instead of Chart sheets.

The other thing is that the approach of placing a index number on each sheet that can be used in the chart source data wont work.

I'll try to address those two things in a revised version.

Please post the reference you are currently using to reference the chart source data from the first Athlete's profile chart.