Create Pivot Table and Pivot Chart Using VBA and Auto Refresh the Pivot Table Whenever the Source Data Changes

 Pivot Table - Assuming the Data and the Pivot table both are on Sheet1 in the workbook.

Sub PivotTableChart()

Dim pc As PivotCache

Dim pt As PivotTable

Dim lrow As Integer

Dim lcol As Integer

Dim rng As Range

ThisWorkbook.Activate

Sheet1.Activate

lrow = Cells(Rows.Count, 1).End(xlUp).Row

lcol = Cells(1, Columns.Count).End(xlToLeft).Column

'Debug.Print lrow & "-" & lcol

Set rng = Range(Cells(1, 1), Cells(lrow, lcol))

'Debug.Print rng.Address


Set pc = ThisWorkbook.PivotCaches.Create(xlDatabase, rng, 6)

Set pt = pc.CreatePivotTable(Sheet1.Range("z5"), "MyPivot")

With Sheet1.PivotTables("MyPivot")

    With .PivotFields("Location")

            .Orientation = xlRowField

            .Position = 1

    End With

    

'    .AddDataField Sheet1.PivotTables("MyPivot").PivotFields("InsuredValue"), _

'    "Sum of InsuredValue", xlSum

    With .PivotFields("InsuredValue")

            .Orientation = xlDataField

            .Position = 1

            .Function = xlSum

            '.fieldsname = "Sum of InsuredValue"

            .NumberFormat = "#,##0"

    End With

    Note:

    'If (.Function =xlSum ) not works then use below code

    'Ex: .PivotFields("Sum of InsuredValue").Function = xlSum


    With .PivotFields("Region")

            .Orientation = xlPageField

            .Position = 1

    End With

End With

    Call Pivot_Pie_Chart

'Sheet1.PivotTables("MyPivot").PivotFields("Region").ClearAllFilters

'    Sheet1.PivotTables("MyPivot").PivotFields("Region").CurrentPage = "East"

'Sheet1.Columns("AA").NumberFormat = "00,000.0"

Set pc = Nothing

End Sub

Pivot Chart: Assuming the Pivot table and the Pivot Chart both are on Sheet1 in the workbook.

Sub Pivot_Pie_Chart()

'Create Pie or any chart

Dim sh As Shape

Set sh = Sheet1.Shapes.AddChart2

'sh.Chart.SetDefaultChart xlPie

sh.Chart.SetSourceData Sheet1.Range("aa5")

sh.Chart.ChartType = xlPie

sh.Chart.HasTitle = True

sh.Chart.SetElement msoElementDataLabelOutSideEnd

sh.Chart.ChartTitle.Text = "Pie Chart"

sh.Chart.ShowAllFieldButtons = False

sh.Chart.Parent.Left = Range("ac5").Left

sh.Chart.Parent.Top = Range("ac5").Top

'sh.Chart.Parent.Width = 350

'sh.Chart.Parent.Height = 250

sh.Chart.SetElement msoElementLegendBottom

Sheet1.Range("a1").Select

End Sub


 Auto Refresh Pivot Table: Keep the below code in the sheet1 code module (Select Worksheet in Object and SelectionChange in Procedure) to auto-refresh the Pivot Table whenever source data changes.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

ThisWorkbook.Activate

Sheet1.Activate

lrow = Cells(Rows.Count, 1).End(xlUp).Row

lcol = Cells(1, Columns.Count).End(xlToLeft).Column

'Debug.Print lrow & "-" & lcol

Set rng = Range(Cells(1, 1), Cells(lrow, lcol))

'Debug.Print rng.Address


'Set pc = ThisWorkbook.PivotCaches.Create(xlDatabase, rng, 6)

'Set pt = pc.CreatePivotTable(Sheet1.Range("z5"), "MyPivot")

'Debug.Print rng.Address


PivotTables("MyPivot").ChangePivotCache ActiveWorkbook.PivotCaches. _

        Create(SourceType:=xlDatabase, SourceData:= _

        rng, Version:=7)

'ActiveWorkbook.RefreshAll

'ThisWorkbook.RefreshAll

End Sub


Comments

Post a Comment

Popular posts from this blog

Power Automate - Automatically fetch data from Power BI in to Excel and Send the copy of the Excel file via Email

Image
Power Automate - Automatically fetch data from Power BI in to Excel and Send the copy of the Excel file via Email Step-1 Step-2 Step-3 Using Command text we can make changes in the data we fetch from the Power BI. Like add fields/columns, filter data, rename columns. It is a DAX formula. Step-4 Step-5      Step-6 Step-7 Posting message on Teams. We can post message to a Teams Group  also by selecting Group chat from Post in and select the Teams Group from the Group chat  dropdown that will appear after making selection. Step-8 Location:  We need to select the Group  on SharePoint in which our file is located. Document Library: We need to select the Documents option from the dropdown. File: Select the file on which you want to run the script. Script: Select the script to perform the desired action. Step-9 Step-10 Step-11 Using Filter Query  we can decide which file properties we want to get. We are performing this step to attach excel as an attach...
Read more

Separate Text (Characters) & Numbers from Alpha Numeric String Using Formula and Macro (VBA)

Image
Have you ever come across the data where the text (characters) and numbers are put together in a single cell. Like Employee Name and Employee Code, Customer Name and Customer Number, etc. If the answer is Yes and you want to learn how to separate them using  formula  then this post is definitely for you. This type of data comes into three flavours: 1) Text and Number (Sujeet123) 2) Number and Text (123Sujeet) 3) Text and Numbers tangled (S1u2j3e4e5t6, 1s2u3j4e5e6t) We can separate the first 2 types using the formula and for 3rd type, we need to write a few lines of code (Macro). Let's start with the First one: 1) Text and Number (Sujeet123) Ex-1 Let's assume that  Cell A2  holds Sujeet123 in Sheet1. we will use the below formula with the Left and Right function to separate the Text and Number . =Min(find({01,2,3,4,5,6,7,8,9},A2&"0123456789")) The above formula will give us the starting position of the first Number. To find the Text Part  put the below...
Read more

File System Object

  FSO - Check If a file exists, if exists then delete the file. Dim fso As Scripting.FileSystemObject Sub test() Application.ScreenUpdating = False Set fso = New Scripting.FileSystemObject Dim flname As String flname = "D:\Excel Practice\Test.txt" If Not fso.FileExists(flname) Then Exit Sub Else 'flname.Delete--------Incorrect fso.DeleteFile (flname) '---Correct MsgBox "file deleted", vbInformation End If Application.ScreenUpdating = True End Sub '--------------------------------------------- Sub DeleteAllFilesFromAFolder() Dim fso As Object Dim fd As Object Dim fl As Object Dim str_Path As String str_Path = "D:\New Folder\" Set fso = CreateObject("Scripting.FileSystemObject") Set fd = fso.getfolder(str_Path) For Each fl In fd.Files     fl.Delete Next fl End Sub Delete a file without using Loop If obj_fso.fileexists(ThisWorkbook.Path & "\" & "xyz.xlsx") Then obj_fso.Deletefile ThisWorkbook.Path & ...
Read more