Showing posts with label Pivot Table VBA. Show all posts
Showing posts with label Pivot Table VBA. Show all posts

Tuesday, December 8, 2020

Change the range of source data of a pivot table programmatically using VBA

 
Option Explicit

Sub Copy_Paste_To_DPR_Pivot()
'Find the last used row in both sheets and copy and paste data below existing data.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lcopyLastRow As Long
Dim lDestLastRow As Long

'Open method requires full file path to be referenced.

Workbooks.Open "C:\Users\allso\Desktop\new vba projects\new project subham brother\DPR NOV 2020.xlsb"

  'Set variables for copy and destination sheets
  Set wsCopy = Workbooks("New Raw File Dual@.xlsb").Worksheets("NEW")
  Set wsDest = Workbooks("DPR NOV 2020.xlsb").Worksheets("RAW FILE")
    
 
 
  'clear content on the destination sheet except header
 
  wsDest.Rows("2:" & wsDest.Rows.Count).ClearContents
 
   '1. Find last used row in the copy range based on data in column A
  lcopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
 
 
  'Copy range to clipboard
  wsCopy.range("A2:P" & lcopyLastRow).Copy
 
  'PasteSpecial to paste values, formulas, formats, etc.
  wsDest.range("A2").PasteSpecial Paste:=xlPasteValues
    
    'arrange and refresh the pivot table
    
    'Set variables for copy and destination sheets
  Set wsCopy = Workbooks("DPR NOV 2020.xlsb").Worksheets("RAW FILE")
  Set wsDest = Workbooks("DPR NOV 2020.xlsb").Worksheets("PIVOT")
  lcopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
  Dim datarange As String
 
   datarange = wsCopy.Name & "!" & range("A1:P" & lcopyLastRow).Address(ReferenceStyle:=xlR1C1)
   
   
   


        
        wsDest.PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        datarange)
 
 
 

  'Close the workbook

  Workbooks("DPR NOV 2020.xlsb").Close SaveChanges:=True
 
End Sub




Saturday, February 8, 2020

Automating Pivot Table using VBA,VBA Teacher Sourav,Kolkata 08910141720

Sub pivotvba()
 With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
For Each wks In Application.Worksheets
        If wks.Name = "Pivot_Table" Then wks.Delete
    Next

 cntsheets = Application.Sheets.Count
    Set NewSheet = Application.Worksheets.Add(After:=Worksheets(cntsheets))
    NewSheet.Name = "Pivot_Table"
   
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
 Application.DisplayAlerts = True
  Dim pt As PivotTable
  Dim pc As PivotCache
  Dim pf As PivotField
  Dim pi As PivotItem

'set the pivotcache
Sheets("Data").Select
Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, Sheets("Data").Range("A3").CurrentRegion)

'create the pivot table
Sheets("Pivot_Table").Select
Set pt = ActiveSheet.PivotTables.Add(pc, Range("A3"), "Pivot_Table_1")

'put the fields

With pt
'.PivotFields("Salesperson").Orientation = xlColumnField
.PivotFields("Category").Orientation = xlRowField
.PivotFields("Salesperson").Orientation = xlColumnField
.PivotFields("Revenue").Orientation = xlDataField
'set the number format

.DataBodyRange.NumberFormat = "$#,##0.00"

'classic view

.InGridDropZones = True


'switch back from classic view
.InGridDropZones = False

'add calculated field

.CalculatedFields.Add "Eligible for bonus", "= IF(Revenue >1500,1,0)", True
.PivotFields("Eligible for bonus").Orientation = xlDataField
'Changing the caption of the calculated field,removing the sum of part
.DataPivotField.PivotItems("Sum of Eligible for bonus").Caption = "Eligible for bonus ? "

'changing the number format of the callculated field so that it becomes only 1 and 0

.PivotFields("Eligible for bonus ? ").NumberFormat = "#,##0"
'converting 1 and 0 to yes and no

.PivotFields("Eligible for bonus ? ").NumberFormat = """Yes"";;""No"""

'Add region column as report filter
.PivotFields("Region").Orientation = xlPageField


End With
'Setting default filter

Set pf = pt.PivotFields("Region")
With pf
   For Each pi In pf.PivotItems
   If pi.Name = "East" Then
   pi.Visible = True
   Else
   pi.Visible = False
   End If
  
   Next pi
 End With

'setting filter in a more customized way,suppose
'we want to see revenue generated by eastern region with
'the category beverages,we already filtered the data by east
'now let us filter the filtered table by a cirtain category

Set pf = pt.PivotFields("Category")
With pf
   For Each pi In pf.PivotItems
   If pi.Name = "Beverages" Then
   pi.Visible = True
   Else
   pi.Visible = False
   End If
  
   Next pi
 End With

'Suppose we want to filter column by both east and west

Set pf = pt.PivotFields("Region")
With pf
   For Each pi In pf.PivotItems
   If pi.Name = "East" Or pi.Name = "West" Then
   pi.Visible = True
   Else
   pi.Visible = False
   End If
  
   Next pi
 End With
'Suppose we want to filter the row by both beverages and candy
Set pf = pt.PivotFields("Category")
With pf
   For Each pi In pf.PivotItems
   If pi.Name = "Beverages" Or pi.Name = "Candy" Then
   pi.Visible = True
   Else
   pi.Visible = False
   End If
  
   Next pi
 End With

'Update the pivot table

ThisWorkbook.RefreshAll
End Sub