5

I record my expenses in an Excel spreadsheet. In a second sheet I have a pivot table that allows me to group my expenses by month and by category to see the totals. If I double click on a cell, a new sheet is automatically added that displays a list of expenses for the month/category selected. That's pretty great, except that the new sheet contains a copy of the expenses, so I can't update them. Also, I have to keep deleting these sheets each time I drill down, which is pretty annoying.

I found one example that explains how to automatically rename and remove the added sheets here: http://www.contextures.com/excel-pivot-table-drilldown.html

What I would really like is to switch back to the first sheet and update the filters accordingly. Does anyone know how I might achieve that?

Many thanks,

Patrick

5
  • 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
    Jun 29, 2012 at 23:41
  • 1
    The 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
    Jun 29, 2012 at 23:47
  • 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. Jun 30, 2012 at 9:19
  • I don't have a license for Access, although perhaps that is an avenue worth exploring, thanks. Jun 30, 2012 at 9:19
  • 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
    Aug 28, 2012 at 0:10

1 Answer 1

1

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
2
  • I gave your solution a whirl using Excel Mac 2011, but I'm afraid it didn't work. There were a couple of methods that weren't supported that I commented out, but then it just displayed a popup with "400" when I tried to run the macro. Alas. I haven't tried this on Windows yet. Oct 6, 2012 at 11:28
  • 1
    It's working fine for me on Windows 7 Pro SP1, Excel 2010 32 bit.
    – nutsch
    Oct 10, 2012 at 16:53

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .