VBA Code to Show Details on a Pivot table until there is no more data to show details from

[MrLQsc]

First off, I want to specify that I have very little to no knowledge of VBA.
What I have put together is a mere step by step copy and paste code.

I am just trying to simplify my code from have over 1000 lines of code down to as few as possible, but still have the same outcome.

I have a excel file that is pulling data from 2 different files, to make a specialized report.

I am unable to share the file, as the data in extremely sensitive, but I will try to explain as detailed as possible.

The file that is being opened has a pivot table on the sheet that is first displayed. The code will then change a few things on the pivot table that do not need to be displayed. It will then "show details" on the first row of the values. Copy the data from that table, into a specific sheet, and repeat. The data will be pasted at the bottom of the previous paste until there are no more rows/values to "show details".

Any help will be greatly appreciated.

Thank in advance.

Sub GetData()
'
' GetData Macro
' Get Data
'
'
    Sheets("FileList").Select
    PathName = Range("J5").Value
    Filename = Range("J3").Value
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=PathName & Filename, _
        Notify:=False
    ActiveSheet.PivotTables("PivotTable2").PivotFields("ReportDate").CurrentPage = _
        "(All)"
    ActiveSheet.PivotTables("PivotTable2").PivotFields("ReportDate"). _
        EnableMultiplePageItems = True
    ActiveSheet.PivotTables("PivotTable2").PivotFields("SrTM").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("PivotTable2").PivotFields("TM").Orientation = xlHidden
    With ActiveSheet.PivotTables("PivotTable2")
        .ColumnGrand = False
        .RowGrand = False
    End With
    Range("C4").Select
    Selection.ShowDetail = True
    Range("A2:S2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Testing.xlsx").Activate
    Sheets("RawData").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Windows("Shrink.xlsx").Activate
    ActiveWindow.SelectedSheets.Delete
    Range("C5").Select
    Selection.ShowDetail = True
    Range("A2:S2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("Testing.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Windows("Shrink.xlsx").Activate
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True

End Sub

 

[Jerry Sullivan]

Welcome to MrExcel,

If you ShowDetails based on the Grand Total row, it should produce the same resulting data that you would get from combining the ShowDetails for each row.

Here's a macro I've used previously for that purpose...

Sub ShowGrandTotalDetail()
'--shows grand total drill down detail of first pivotTable
'    in activesheet.
 
 Dim sMessage As String
 
 With ActiveSheet.PivotTables(1)
   '--validate requirements met to allow grand totals drilled down
   Select Case True
      Case .DataFields.Count = 0
         sMessage = "Must have at least one DataField."
      Case .RowFields.Count + .ColumnFields.Count = 0
         sMessage = "Must have at least one RowField or ColumnField."
      Case .RowFields.Count And Not .RowGrand
         sMessage = "Grand Totals are Off for Rows."
      Case .ColumnFields.Count And Not .ColumnGrand
         sMessage = "Grand Totals are Off for Columns."
      Case Else
         '--ok- requirements met
   End Select
   
   If Len(sMessage) = 0 Then
     With .TableRange1
        '--drill down on last cell in pivot
        .Cells(.Rows.Count, .Columns.Count).ShowDetail = True
     End With
   Else
      MsgBox Prompt:=sMessage, Title:="Grand Totals detail can't be shown", _
         Buttons:=vbExclamation
   End If
 End With

 

[MrLQsc]

this helped heaps, sorry for the extremely late reply.