Macro to show pivot table details..Any ideas?

**Poison990** · 02-26-2009, 09:56 AM

Hello,

I have a pivot table in a tab called billing.

The size of this pivot table depends on how many different customers are in the data tab.

What I want is a macro that will show the details as if you were to double click on the grandtotal, but the grandtotal in column c is never in the same row and I am having difficulty coming up with a macro to do this.

There are some other functions it is performing as well so I just need to add this to the existing macro code.

Thanks
Greg

**DonkeyOte** · 02-26-2009, 10:06 AM

Greg, without seeing the PT etc it's hard to comment... if we assume

a) Grand Total always appear in Column A
b) Field in question always appears in Column C

Then perhaps along the lines of:

Public Sub ShowPTDetail()
Dim wsPT As Worksheet
On Error GoTo Handler:
Set wsPT = Sheets("Sheet1") 'sheet containing PT
wsPT.Cells(Application.Match("Grand Total", wsPT.Columns(1), 0), "C").ShowDetail = True
ExitPoint:
Set wsPT = Nothing
Exit Sub

Handler:
MsgBox "Error Has Occurred etc...",vbCritical,"Routine Terminated"
Resume ExitPoint
End Sub

**Poison990** · 02-26-2009, 10:18 AM

Hello,

I tried just pasting that macro in and I got the error message. Here is what the PT looks like.

Hopefully this will help

Thanks Again
Greg

**DonkeyOte** · 02-26-2009, 10:20 AM

Per the annotation in the code did you alter the sheet name being referenced to be that containing the Pivot Table ?

Set wsPT = Sheets("Sheet1") 'sheet containing PT

**Poison990** · 02-26-2009, 12:16 PM

I did change it, now its crashing my excel sheet.

It keeps coming up with the error message, over and over again even after I click OK on it.

Any ideas?

Thanks Greg

Here is the code:

Sub Macro3()
'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+Shift+T
'
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets("data").Select
    Range("A2").Select
    
        Cells.Replace What:="BULKMATIC TRANSPORT COMPANY", Replacement:= _
        "CONAGRA", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
        SearchFormat:=False, ReplaceFormat:=False
        
Dim cell As Range
Dim rng As Range
On Error GoTo 100

Worksheets("data").Activate
Set rng = Range("D2:D5000")

For Each cell In rng
If cell.Value = "" Then GoTo 100
Select Case cell.Value

        
        Case "CARGILL INC"
            Range("A" & cell.Row, "AK" & cell.Row).Copy
            Sheets("Cargill").Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = True
         End Select
         Next cell
    ActiveWorkbook.Worksheets("data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("data").Sort.SortFields.Add Key:= _
        Range("A:AK"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("data").Sort.SortFields.Add Key:= _
        Range("D:D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
100
    Sheets("rated").Select
    Range("C4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    Sheets("billing").Select
    Range("B4").Select
    ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
    
    
    Sheets("Cargill").Select
    Cells.Select
    Range("B2").Activate
    ActiveWorkbook.Worksheets("Cargill").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Cargill").Sort.SortFields.Add Key:=Range("M2:M5000" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Cargill").Sort
        .SetRange Range("A1:AK5000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Cargill").Select
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("N:N").Select
    Selection.Style = "Currency"
    Range("N2").Select
    
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],0,728)"
    Selection.AutoFill Destination:=Range("N2:N5000"), Type:=xlFillDefault
    Selection.AutoFill Destination:=Range("N2:N5000"), Type:=xlFillDefault
    Range("N2:N5000").Select
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Vehicle Charge"
    With ActiveCell.Characters(Start:=1, Length:=14).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
    Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(14), _
    Replace:=True, PageBreaks:=True, SummaryBelowData:=True
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AL$5001").AutoFilter Field:=4, Criteria1:="<>"
        Range("N5002").Select
    ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-5000]C:R[-1]C)/728"
    Range("N5002").Select
    Selection.NumberFormat = "General"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    
    Columns("B:D").EntireColumn.AutoFit
    Columns("G:H").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("M:T").EntireColumn.AutoFit
    Columns("AD:AI").EntireColumn.AutoFit
    
Application.DisplayAlerts = True
    

Dim wsPT As Worksheet
On Error GoTo Handler:
Set wsPT = Sheets("billing")
wsPT.Cells(Application.Match("Grand Total", wsPT.Columns(1), 0), "C").ShowDetail = True
ExitPoint:
Set wsPT = Nothing


Handler:
MsgBox "Error Has Occurred etc...", vbCritical, "Routine Terminated"
Resume ExitPoint

    

 
    
Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False



End Sub

**DonkeyOte** · 02-26-2009, 01:08 PM

I'm not quite sure where to begin but first to resolve your issue (I hope) you need to change the below section:

Dim wsPT As Worksheet
On Error GoTo Handler:
Set wsPT = Sheets("billing")
wsPT.Cells(Application.Match("Grand Total", wsPT.Columns(1), 0), "C").ShowDetail = True
ExitPoint:
Set wsPT = Nothing


Handler:
MsgBox "Error Has Occurred etc...", vbCritical, "Routine Terminated"
Resume ExitPoint

    

 
    
Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False



End Sub

To something more along the lines of:

Dim wsPT As Worksheet
On Error GoTo Handler:
Set wsPT = Sheets("billing")
wsPT.Cells(Application.Match("Grand Total", wsPT.Columns(1), 0), "C").ShowDetail = True
ExitPoint:
Set wsPT = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

Handler:
MsgBox "Error Has Occurred etc...", vbCritical, "Routine Terminated"
Resume ExitPoint

End Sub

As it is you're going into the error handler as part of the routine and thus a perpetual loop... also as above you should be resetting your App settings to TRUE not FALSE ... Events unlike ScreenUpdating will not reset to True by default and is pretty much guaranteed to cause you major headaches.