MacroProblem-PivotTable on multiple worksheets

[cgeorge4]

I am so happy to have found this fabulous help site. I am extremely adept using Excel - but begining to use Macros - yet I can record, write some simple ones, and certainly understand reading them.

I need a macro that will create a pivot table on all my worksheets within my workbook.

Here are the specifics of my workbook:

1 sheet is always the master and is called "Text Source" - this particular sheet does not require a pivot table.

Other than the 'master' sheet - there maybe 1 to 10 additional sheets created each month based on that month's data -and each sheet will have a different name. ( I successfully wrote/recorded a macro that creates these additional sheets and it works perfectly)

I know that the problem is with the pivot table cache - where the pivot table number changes each time you create a pivot table. I have tried diff macros and the problem is always the next pivot table number.

Please help me: I need a macro to create a pivot table on each new sheet - no matter how many new sheets there r please.

Here r my worksheet details:

1) Each new sheet will always have a different name
2) Each new sheet will always have the same number of columns (A to N)
3) Each new sheet will always have a header row - in row 1 (A to N)
4) Each new sheet will always have various numbers of rows (not more than 65k though)

5) Each pivot table placement should be on P4
6) From the field list - "Site Code" should be placed in "Row Labels"
7) From the field list - "Site Code" should be placed in "Values" as a count

8) The Field List should be hidden after the pivot tables have been created.

9) The pivot table syle and color should be "Pivot Style Dark 7"

10) And last but not least - the whole sheet font should be "Calibri" w/ font size "8".

I read a lot of blogs and hope that I have written my details clearly.
Please help....I have been trying for 3 days and tears are my next option.

Thank you soooooo much.
Juicy,

 

[dk]

First time I've been called "darling" on this board

Glad the macro worked for you.

Cheers
DK

 

[cgeorge4]

Dear DK,

you are certainly a macro darlng - but I will refrain from writing Darling or Honey

I have a question related to the code you provided me.

I would like to add 1 more action to occur directly after the macro creates a pivot table on each sheet - except "Text Source".

Your macro places each pivot table at column "P" but also takes up column "Q" - which is perfect.

I would need this new code to copy/value each PT on each sheet (except the "Text Source" sheet) to the next 2 columns (R and S) please.

I recorded a macro and selected all worksheets then copy/value the PT"s to column R and S - but I received an error because there was 1 new sheet and the macro failed.

I've tried but cannot succeed without your assistance.
Please tell me how to write a code to select any sheet except "Text Source" and copy/value each PT to the next 2 columns.

I hope this request is okay to post in this thread.

Thank u so much hun,....in advance

 

[cgeorge4]

DK,

Thank you so much for your help before

But....I am still needing one more thing.

The code you provided me to create pivot tables on each new worksheet in column "P" worked perfectly.


Now I need the pivots on each sheet to be copy/value/pasted just beside their individual pivot tables.

I've tried recording a macro to do just that by "selecting all sheets then deselecting the "Text Source" sheet then doing a copy/value/paste - then I stopped the recording.

This only works if there are no new sheets. If there is a additional new sheet create by the 1st macro - this 2nd macro doesn't work.

Thanks in advance,

Here is my 2nd macro:
Sub COPYVALUE_PIVOTS_11()

Sheets(Array("Account Setups", "ACNOF", "Exceptions", "Pay Now", "Service Bills", _
"Term")).Select
Sheets("Term").Activate
Columns("P:Q").Select
Selection.Copy
Columns("R:R").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

 

[dk]

Here is one method that loops through the sheets. It would be quicker if the macro selected the relevant sheets and did the copy/paste in one go (as you have done in the code you posted) but I'm not sure how to do off the top of my head:

Sub ConvertSheetsToValues()

    Dim wbTarget As Workbook
    Dim shtEach As Worksheet

    'This is the workbook containing the pivot tables
    Set wbTarget = ActiveWorkbook
    
    
    
    For Each shtEach In wbTarget.Worksheets

        If shtEach.Name <> "Text Source" Then
            shtEach.Cells.Copy
            shtEach.Range("A1").PasteSpecial xlPasteValues
        End If

    Next shtEach

    Application.CutCopyMode = False
    

End Sub

HTH
DK

 

[cgeorge4]

DK,

thank u so much for this.

I think I can take portions of my code and the one u just provided me to make this work.

I will try tomorrow morning at work to see if I have success

i hope u dont mind if i let u know

thanks,

juicy,

 

[cgeorge4]

DK,

I seem to be having a problem.

I have a sheet array in my code that I don't know how to revise.

The sheet array in the code refers to 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>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>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 pivot table part of the macro is failing because I have a new category - which means that a sheet named "New" is created but is not part of the array. I believe that is the problem.

Would you be able to look at my code and see if you can help me?
Thank you so much!


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