Monday, October 2, 2017

VBA code to collect pivot data source details for all pivot in a workbook!!!

Data Source is key factor to create pivot table in excel. On the basis of data source pivot get refreshed and we can made changes in pivot structure. Thus, to know pivot data source is very essential to structure pivot layout. In this topic, we will see how can be data source information for various pivot collected using excel macro.


Here, we go for excel macro which will collect pivot data source details for all pivots in a workbook: 

Option Explicit

Sub Pivot_DataSource()
' Author: Dreams24d
' Written for VBA Tricks and tips blog
' https://vbatricksntips.com

'Declare Variables
Dim pvt As PivotTable
Dim ws As Worksheet
Dim strPvt As String
Dim sht As String
Dim pvtSource As String
Dim pvtName As String
Dim i As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

strPvt = "       Pivot Name     Sheet Name   Source Data" & vbNewLine
i = 1

'For loop through each worksheets
    For Each ws In ActiveWorkbook.Worksheets
        Worksheets(ws.Name).Select

        'Loop to select pivot tables in each worksheet
        For Each pvt In ws.PivotTables
           
           pvtName = pvt.Name
           pvtSource = pvt.SourceData
           sht = ws.Name
           
            'Pass Pivot details to variables in order to show in message. comment or delete this if not required
            strPvt = strPvt & i & ".    " & pvtName & "         " & sht & "       " & pvtSource & vbNewLine
            
            'Uncomment below lines to get pivot table list in sheet1
            'ActiveWorkbook.Sheets("Sheet1").Range("A" & i).Value = pvtName
            'ActiveWorkbook.Sheets("Sheet1").Range("B" & i).Value = sht
            'ActiveWorkbook.Sheets("Sheet1").Range("C" & i).Value = pvtSource

            i = i + 1
            
        Next pvt
    Next ws
    
MsgBox "Pivot Tables and their data source listed as Below: " & vbNewLine & vbNewLine & strPvt, vbInformation, "Pivot and Data Source"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

No comments: