Generate Underlying Data From Excel Pivot Table

by Bill Dowling 2. April 2013 09:57

The following code will extract the underlying data that makes up a Pivot Table in Excel. Manually, if you double-click in a cell in the Total Row, you will get a new worksheet (tab) containing all the data that made up the Pivot Table. This routine will find all Pivot Tables, locate the total row and create a new worksheet (tab) with it's data.

 

    Dim xlApp As Excel.Application, xlWb As Excel.Workbook, xlWs As Excel.Worksheet
    Dim xlRng As Excel.Range, xlPt As Excel.PivotTable
    '***************************
    ' Open up the Excel Workbook
    '***************************
    Set xlApp = New Excel.Application
    xlApp.Visible = False
    xlApp.DisplayAlerts = False
    Set xlWb = xlApp.Workbooks.Open(sInputFile, 0, False)
    '*************************************************
    ' Find the Pivot table and get the underlying data
    '*************************************************
    If xlWb.PivotCaches.Count <> 1 Then Err.Raise vbObjectError + 0, , "Wb does not have 1 PivotTable"
    For Each xlWs In xlWb.Sheets
        For Each xlPt In xlWs.PivotTables
            xlWs.Activate                           ' make active/current for select to work
            nIndex = xlWs.Index                     ' when new WS created, put before PT sheet, so same WS index
            Set xlRngPT = xlPt.DataBodyRange
            sRange = xlRngPT.Address
            nPos = InStr(1, sRange, ":")
            sRange = Mid$(sRange, nPos + 1, Len(sRange) - (nPos - 1)) & ":" & Mid$(sRange, nPos + 1, Len(sRange) - (nPos - 1))
            Set xlRng = xlWs.Range(sRange)          ' points to last column in totals
            xlRng.Select
            xlRng.ShowDetail = True
        Next
    Next

Tags:

Excel

Add comment

About the author

Bill Dowling has been a VB and .Net programmer for as long as he can remember.

Month List