Not extremely straightforward. I've rebuilt code from a daily dose of excel to take advantage of the better filtering options of excel 2010. If you select a data point in your pivot and run the macro, it will give you the matching lines in your source data. It does so by using the Show Details function, then creating a filter for each column to match the data.
You can set it on a new right-click button, or overwrite the default show details behavior.
Private mPivotTable As PivotTable
Sub GetDetailsOnSource()
'turn off updates to speed up code execution
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
On Error Resume Next
Set mPivotTable = Selection.PivotTable
On Error GoTo 0
If Not mPivotTable Is Nothing Then
If mPivotTable.PivotCache.SourceType <> xlDatabase Or _
Intersect(Selection, mPivotTable.DataBodyRange) Is Nothing Then
Set mPivotTable = Nothing
End If
End If
Selection.ShowDetail = True
GetDetailInfo
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Sub GetDetailInfo()
Dim rCell As Range
Dim rData As Range
Dim vMin As Variant, vMax As Variant
Dim rSource As Range
Dim lOldCalc As Long, sh As Worksheet
Dim colItems As Collection, arrFilter As Variant, lLoop As Long, lLastRow As Long
Dim bBlanks As Boolean, bNumbers As Boolean, sNumberFormat As String
Set sh = ActiveSheet
If Not mPivotTable Is Nothing Then
lOldCalc = Application.Calculation
Application.Calculation = xlCalculationManual
Set rSource = Application.Evaluate(Application.ConvertFormula(mPivotTable.SourceData, xlR1C1, xlA1))
rSource.Parent.AutoFilterMode = False
rSource.AutoFilter
lLastRow = sh.ListObjects(1).Range.Rows.Count
sh.ListObjects(1).Unlist
'Loop through the header row
For Each rCell In Intersect(sh.UsedRange, sh.Rows(1)).Cells
If Not IsDataField(rCell) Then
If Application.WorksheetFunction.CountIf(rCell.Resize(lLastRow), "") > 0 Then bBlanks = True Else bBlanks = False
rCell.Resize(lLastRow).RemoveDuplicates Columns:=1, Header:=xlYes
If Application.WorksheetFunction.CountA(rCell.EntireColumn) = Application.WorksheetFunction.Count(rCell.EntireColumn) + 1 _
And Not IsDate(sh.Cells(Rows.Count, rCell.Column).End(xlUp)) Then 'convert numbers to text
bNumbers = True
rCell.EntireColumn.NumberFormat = "0"
rCell.EntireColumn.TextToColumns Destination:=rCell, DataType:=xlFixedWidth, _
OtherChar:="" & Chr(10) & "", FieldInfo:=Array(0, 2), TrailingMinusNumbers:=True
Else
bNumbers = False
End If
arrFilter = sh.Range(rCell.Offset(1), sh.Cells(sh.Rows.Count, rCell.Column).End(xlUp).Offset(IIf(bBlanks, 1, 0))).Value
If Application.WorksheetFunction.Subtotal(3, rCell.EntireColumn) = 1 Then
rSource.AutoFilter Field:=rCell.Column, Criteria1:=""
Else:
arrFilter = Application.Transpose(arrFilter)
sNumberFormat = rSource.Cells(2, rCell.Column).NumberFormat
If bNumbers Then _
rSource.Columns(rCell.Column).NumberFormat = "0"
rSource.AutoFilter Field:=rCell.Column, Criteria1:=arrFilter, Operator:=xlFilterValues
rSource.Cells(2, rCell.Column).NumberFormat = sNumberFormat
End If
Set arrFilter = Nothing
End If
Next rCell
'so it doesn’t run at next sheet activate
Set mPivotTable = Nothing
Application.Calculation = lOldCalc
'Delete the sheet created by double click
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
rSource.Parent.Activate
End If
End Sub
Private Function IsDataField(rCell As Range) As Boolean
Dim bDataField As Boolean
Dim i As Long
bDataField = False
For i = 1 To mPivotTable.DataFields.Count
If rCell.Value = mPivotTable.DataFields(i).SourceName Then
bDataField = True
Exit For
End If
Next i
IsDataField = bDataField
End Function
it is possible to do with VBA, but i don't have a general solution - have you considered using some other business intelligence tools such as QlikView?
– Aprillion – 2012-06-29T23:41:45.1171The better solution is to switch to MS Access and create reports that you can drill down on. When done looking at the reports, simply close it and when you open it again, new data is waiting for you. – wbeard52 – 2012-06-29T23:47:44.033
I was kind of hoping for a VBA solution. I had a look at QlikView, seems cool, the personal edition is free, I might give it a try. – Patrick J Collins – 2012-06-30T09:19:27.323
I don't have a license for Access, although perhaps that is an avenue worth exploring, thanks. – Patrick J Collins – 2012-06-30T09:19:50.973
I've suggested this be moved to StackOverflow since no one's posted an answer here yet and your question is about VBA. Maybe you will have more luck there. – Excellll – 2012-08-28T00:10:07.323