Pivot Table Code Modifications

[dwhite30518]

I have the following pivot table code. I want to be able to change it from it running on all sheets int he workbook to run on just the worksheet I am working with. The Code I currently have is...

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 <> "Summary" 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("E1")

'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("Item"), "Count of Serial Rcvd", xlCount


With pvt.PivotFields("Item")
.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

What do I need to do in order to create a shortcut keys to run the code? How do I also change the code so that it only works on the current worksheet instead of creating pivot tables on all worksheets?

Thanks!!!!

[shekhar1660]

Hi,

For assigning Shortcut key:
If you are using Excel 2003 then

Go to Tools (Menu bar) > Macro > Macros...> Highlight the macro (macro name) > Click on Options > now you will be able to assign the shortcut key.


As per my observation, this macro is creating pivot only when there is no worksheet available by the name of Summary.

[dwhite30518]

I am using excel 2010.

This current code loops to include every worksheet within the workbook except the sheet labeled Summary. How do I change the code to only run on the worksheet I am currently working with. I do not want it to create pivots for every worksheet every time I run this macro. If I need to completely re-write the code, please point me in the right direction...I am mostly new with this and am learning as I go.

[shekhar1660]

Hi,
Try this, I have updated your code:

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


Activesheet.select

'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("E1")

'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("Item"), "Count of Serial Rcvd", xlCount


With pvt.PivotFields("Item")
.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




'Simple error handler in case something goes wrong
ErrHandler:
Application.ScreenUpdating = True
MsgBox "An error occurred: " & Err.Description, vbExclamation, "Error"


End Sub

[dwhite30518]

When I use this code i get the following error:

"An error occurred: Object variable or With block variable not set"

Am I missing something...it looks like this code has those parameters set?

[shekhar1660]

Are you running on Blank workbook or the workbook you have data?

[dwhite30518]

I want to run it on a workbook with data and have the pivot table created on the same worksheet.

[shekhar1660]

Can you share the excel file?

[dwhite30518]

Here is a sample of what I am working with.

[JosephP]

corrected code

Sub CreateAPivotTable()

    Dim shtSource        As Worksheet
    Dim rngSource        As Range
    Dim 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


    Set shtSource = ActiveSheet

    If shtSource.Name <> "Summary" 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("E1")

        '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("Item"), "Count of Serial Rcvd", xlCount


        With pvt.PivotFields("Item")
            .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

    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

to assign a shortcut, press alt+f8, select macro in list and click the Options... button

[shekhar1660]

Hey Joseph,

Thanks so much for updating the code, however I think you missed something.
I have updated that too

Sub CreateAPivotTable()

    Dim shtSource        As Worksheet
    Dim rngSource        As Range
    Dim 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


    Set shtSource = ActiveSheet

    If shtSource.Name <> "Summary" 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("E1")

        '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("Item"), "Count of Serial Rcvd", xlCount


        With pvt.PivotFields("Item")
            .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
    Else
    MsgBox ("Please remove existing sheet with the name of Summary")

    End If

    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

Updation is

' If shtSource.Name <> "Summary" Then
Else
    MsgBox ("Please remove existing sheet with the name of Summary")

[dwhite30518]

Actually...one more thing....if I wanted this pivot table to create an additional column for the count of serial numbers shipped...how should the code look for that?

[dwhite30518]

Shekhar1660-Thanks! That works perfectly!!!!

Thanks to all!!!!

[JosephP]

not sure why you need to remove a sheet called Summary?

[shekhar1660]

Hi,

Just add

pvt.AddDataField pvt.PivotFields("Item"), "Count of Serial Shipped", xlCount

Below

pvt.AddDataField pvt.PivotFields("Item"), "Count of Serial Rcvd", xlCount

[dwhite30518]

I used this code but both columns contain the same data from the serial rcvd colomun...ideas???

[dwhite30518]

I added that code and ran the macro but when the chart gets created, the rcvd and shipped columns are the same numbers even though there are some blanks cells within the records. Ideas?

[shekhar1660]

My fault

Kindly replace both the lines with

pvt.AddDataField pvt.PivotFields("Serial Rcvd"), "Count of Serial Rcvd", xlCount
        pvt.AddDataField pvt.PivotFields("Serial Shipped"), "Count of Serial Shipped", xlCount

If resolved please click on the * at the left side.

[dwhite30518]

When I run this code, the two columns have the same data...the numbers do not reflect was is actually populated in the cells.

[shekhar1660]

Hi,

I am getting the correct results while running the code.

Please follow the instructions:
Remove all of your existing modules
create a new module and update it with:

Sub CreateAPivotTable()

    Dim shtSource        As Worksheet
    Dim rngSource        As Range
    Dim 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


    Set shtSource = ActiveSheet

    If shtSource.Name <> "Summary" 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("E1")

        '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("Serial Rcvd"), "Count of Serial Rcvd", xlCount
        pvt.AddDataField pvt.PivotFields("Serial Shipped"), "Count of Serial Shipped", xlCount

        With pvt.PivotFields("Item")
            .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
    Else
    MsgBox ("Please remove existing sheet with the name of Summary")

    End If

    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

[dwhite30518]

That works!! Thanks!!!

[shekhar1660]

Please mark this post as Resolved

[dwhite30518]

That works!! Thanks!!!