Please help me.....
I don't know why I'm not getting any response to my posts. I'm not upset - curious. I have 2 new posts (different thread) that have received no reply at all from anyone.
This is urgent.......please.
Here is my message again
I have a code that creates new sheets based on category names from a 'Master' sheet.
I have had to add 2 new categories to the master. The code does create a sheet for the new category - but it doesn't have a name - and then the code stops - and I receive a pivot table error message.
I was assisted with this code and it does work brilliantly as long as there isn't a new category other than the ones listed below in red. The code fails because of the sheet array named in the code.....I think. In this line of code:
Sheets(Array("Account Setups", "ACNOF", "Exceptions", "Pay Now", "Service Bills", _
"Term")).Select
Please help me to replace to sheet array section of the code (if that is certainly what the problem is).....with a line of code that will work for any old or new categories from the master. I don't know ahead of time what categories there might be. There might be all the ones listed above and also 1 or 2 new ones......so I need the code to be flexible and perhaps not have their names in the code - but to run on any new sheet.
Thank you,
Here is the code I'm using:
Sub CopyToSheetByType_AndPIVOTS11()
Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range("a2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To lastrow
If .Range("a" & i).Value <> .Range("a" & i + 1).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.name = .Range("a" & iStart).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets(Array("Account Setups", "ACNOF", "Exceptions", "Pay Now", "Service Bills", _
"Term")).Select
Sheets("Term").Activate
Cells.Select
With Selection.Font
.name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Sheets("Term").Select
Range("P1").Select
Dim shtSource As Worksheet
Dim rngSource As Range, rngDest As Range
Dim pvt As PivotTable
On Error GoTo ErrHandler
'this prevents the screen from updating while the macro is running and
'will make the code run faster
Application.ScreenUpdating = False
For Each shtSource In ActiveWorkbook.Worksheets
If shtSource.name <> "Text Source" Then
'Rather than have the pivot table use all rows in column A-N
'just use what has actually been used.
Set rngSource = shtSource.Range("A1").CurrentRegion
'This is where the pivot table will be placed
Set rngDest = shtSource.Range("P4")
'This creates a pivot table. So rather than having to refer to PivotTables("PivotTable14") like before you can just refer to pvt
Set pvt = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngSource, _
Version:=xlPivotTableVersion12).CreatePivotTable(TableDestination:=rngDest, DefaultVersion:=xlPivotTableVersion12)
pvt.AddDataField pvt.PivotFields("Site Code"), "Count of Site Code", xlCount
With pvt.PivotFields("Site Code")
.Orientation = xlRowField
.Position = 1
End With
'Formatting
pvt.TableStyle2 = "PivotStyleDark7"
With shtSource.Cells.Font
.name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveWorkbook.ShowPivotTableFieldList = False
End If
Next shtSource
'Turns screen updating back on - this line is critical otherwise
'it will be turned off after the macro has finished.
Application.ScreenUpdating = True
Exit Sub
'Simple error handler in case something goes wrong
ErrHandler:
Application.ScreenUpdating = True
MsgBox "An error occurred: " & Err.Description, vbExclamation, "Error"
End Sub
