thomaslovell
New Member
- Joined
- Mar 29, 2013
- Messages
- 21
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???
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???
Code:
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