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]

Hi

Can you record a macro creating a pivot table for one sheet and post the code back here. Once we have that then it should be straightforward to turn it into a generic procedure that can be used on all of your sheets.

DK

 

[cgeorge4]

DK, I am so happy. I have been pacing back and forth awaiting a reply.

Here is the code for the pivot table on one of the new sheets per your request:

In case you need to know - the only sheet that I could create a pivot table for was the one called "Term". I just happened to pick that one. The sheet names will vary.......merci beaucoup.


ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Term!R1C1:R1048576C14", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Term!R4C16", TableName:="PivotTable14", DefaultVersion _
:=xlPivotTableVersion12
Sheets("Term").Select
Cells(4, 16).Select
ActiveWorkbook.ShowPivotTableFieldList = True

ActiveSheet.PivotTables("PivotTable14").AddDataField ActiveSheet.PivotTables( _
"PivotTable14").PivotFields("Site Code"), "Count of Site Code", xlCount
ActiveSheet.PivotTables("PivotTable14").PivotFields("Count of Site Code"). _
Orientation = xlHidden
With ActiveSheet.PivotTables("PivotTable14").PivotFields("Site Code")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable14").AddDataField ActiveSheet.PivotTables( _
"PivotTable14").PivotFields("Site Code"), "Count of Site Code", xlCount

With ActiveSheet.PivotTables("PivotTable14").PivotFields("Site Code")
.Orientation = xlRowField
.Position = 1
End With

ActiveWorkbook.ShowPivotTableFieldList = False
ActiveSheet.PivotTables("PivotTable14").TableStyle2 = "PivotStyleDark7"
Cells.Select
Range("I1").Activate
With Selection.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


End Sub

 

[twinetwstr]

I have written several VBA programs that create Pivot Tables from data, but they are all at work .. and I am at home.

There is a trick to getting the PivotTableCash to work properly, and I can't get it. Any help would be appreciated
-----------------------------
Dim FinalRow As Long
Dim MyRange As Range
Dim RangeStr As String
FinalRow = Cells(Application.Rows.Count, 2).End(xlUp).Row
RangeStr = "'Raw Data'!A1:P" & FinalRow

Set MyRange = Range(RangeStr)
Sheets.Add
ActiveSheet.Name = "Response Time 4 x 4"

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
RangeStr, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Response Time 4 X 4!R3C1", TableName:="RespPivot", _
DefaultVersion:=xlPivotTableVersion14
==============================

The Pivot Cashes line errors out, and the table will not create. I know it is in the formatting of something, but I can't remember what. I recorded the code in the Macro Recorder and changed the hard coded table range to the Range variable and the name of the Pivot Table from "PivotTable1" to "RespPivot". I know once the Cash line runs and the table is created, the rest of the macro will run perfectly.

Thanks ahead

Van!!

 

[dk]

Hi mate,

Can you please try this. It should work every time you run it as long as the data starts in cell A1 and there is a field called "Site Code".

The next step would be if you want to automate the creation of each pivot table by looping through each sheet and having the macro create each pivot table. However, see how you get on with this and we can go from there.

HTH
DK

Sub CreateAPivotTable()


    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

    'By default the macro will work on the active sheet but it would be fairly
    'straightforward to make it loop through all sheets in the workbook
    Set shtSource = ActiveSheet

    '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 = ActiveSheet.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 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


    '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

 

[dk]

I have written several VBA programs that create Pivot Tables from data, but they are all at work .. and I am at home.

...
Thanks ahead

Van!!

Hi - you would be better off creating a new thread and asking your question there. Having two questions on the same thread is just going to be confusing

 

[twinetwstr]

Actually it was a related issue, and your answer satisfied my request.

Thanks

Van!!

 

[cgeorge4]

Dear DK,
The code you provided work perfectly. I am so pleased. And your explanations within the code is so helpful and allows me to be assisted and learn at the same time.

But yes, I would like the pivot table creations to loop thru each new worksheet - except the master sheet called "Text Source".

Thank u thank you so much for your time.
Juicy,

 

[dk]

Glad it worked for you. This modified code will loop through all sheets in the active workbook and create a pivot table except on the "Text Source" worksheet.

Sub CreateAPivotTable()

    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

HTH
DK

 

[cgeorge4]

DK Darling,

Thank you so much. The code worked perfectly

You are a god-send. I don't know how to thank you for your time and expertice.

Merci Beaucoup

CGeorge