MacroProblem-PivotTable on Multiple Worksheets Failing

[cgeorge4]

Hello,

I have a macro that creates new sheets with names from a 'master' sheet with various categories - then deletes column "A" in all the new sheets - then creates a pivot table on each new sheet.

The code works perfectly as long as the categories from the 'master' are only the following:
<TABLE style="WIDTH: 165pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=220 border=0><COLGROUP><COL style="WIDTH: 165pt; mso-width-source: userset; mso-width-alt: 8045" width=220><TBODY><TR style="HEIGHT: 11.25pt" height=15><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 165pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 11.25pt; BACKGROUND-COLOR: transparent" width=220 height=15>Account Setups</TD></TR><TR style="HEIGHT: 11.25pt" height=15><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 11.25pt; BACKGROUND-COLOR: transparent" height=15>ACNOF</TD></TR><TR style="HEIGHT: 11.25pt" height=15><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 11.25pt; BACKGROUND-COLOR: transparent" height=15>Service Bills</TD></TR><TR style="HEIGHT: 11.25pt" height=15><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 11.25pt; BACKGROUND-COLOR: transparent" height=15>Exceptions</TD></TR><TR style="HEIGHT: 11.25pt" height=15><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 11.25pt; BACKGROUND-COLOR: transparent" height=15>Pay Now</TD></TR><TR style="HEIGHT: 11.25pt" height=15><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 11.25pt; BACKGROUND-COLOR: transparent" height=15>Term</TD></TR></TBODY></TABLE>

The code failed at the pivot table section after I added a new category to the 'master'. The new category is "Development". I think the issue may be due to a sheet array within the code that only refers to the categories listed above (which doesnt' include the new category). Let me know if I'm wrong

Note:The first part of the macro that creates new sheets based on category names from the 'master' ALWAYS works, no matter how many categories there are.

I'm getting a pivot table error - and the code stops.

I would like the code to create pivot tables on any new sheet no matter the name - and no matter how many sheets there might be. The code has to be flexible and I haven't been able to figure out how to replace the sheet array section if that is the problem.

Thank you so much.
Here is my code:


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

 

[cgeorge4]

Urgent Please......will someone please assist me.


Please......

 

[cgeorge4]

Someone .....please help me with this problem.

Am I doing something wrong?...posting in the wrong place?

Please let me know,
thanks,

juicy,

 

[cgeorge4]

Please help.

 

[cgeorge4]

This is to anyone who is interested in knowing - or who might need a code like this.

Since I didn't get a response from anyone, I was able to figure out how to resolve my problem on my OWN.. It took several evenings - but I did it.

My problem was that I had an Array in the code which didn't encompass every new sheet that might have been created. That's why the pivot tables failed in the code.

HERE IS THE SECTION OF MY ORIGINAL CODE THAT MADE THE PT'S FAIL:

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

HERE IS WHAT I REPLACED IT WITH:
(this section selects every sheet except the one named "Text Source")

Dim wks As Worksheet

For Each wks In Worksheets
If LCase(wks.name) <> "text source" Then
wks.Columns("A").Hidden = True
wks.Cells.Font.Size = 8
End If
Next wks

I hope somebody finds this useful. I'm glad I was forced to figure it out on my own. ....This was the best way to really learn and remember.

I learned a lot - especially about If with End If, and how to use "F8" and "F5".........

Juicy,