Excel User Group
Microsoft Excel blogs, forums, files. Read, ask questions, provide answers.

Swapping pivot table row and column fields back and forth, "transpose" a pivottable

Latest post Fri, Jan 18 2008 12:08 PM by Roger Govier. 1 replies.
  • Thu, Jan 17 2008 4:24 PM

    • minimaster
    • Top 200 Contributor
    • Joined on Thu, Jan 17 2008
    • Posts 1
    • Points 21

    Swapping pivot table row and column fields back and forth, "transpose" a pivottable

    Frequently I found that the desired x-y orientation in a pivot chart requires to switch the row and column fields in the associated pivot table. So I wrote a little procedure that allows to do just that with ease.  I've only tested it so far with relativly simple pivot tables. It seems to work fine so far. I'd appreciate feedback where more sophiscated handling of the pivot table arrangement is neccessary to gurantee failure free switching back and forth. May be there is an easier way to do that, Is there ?

    Sub swapRowColumnFields()
       Dim i            As Integer  ' for next loop counter
       Dim pt           As PivotTable   ' pivot table object handle
       Dim pn()         As Variant  ' buffer to save the names of the original Rowfields
       Dim pc()         As Variant  ' buffer to save the names of the original Columnfields

       Set pt = getPivotTable
       If pt Is Nothing Then
          MsgBox "Error: Can't find pivot table on the active sheet!"
          Exit Sub
       End If

       If pt.RowFields.Count > 0 Then
          ReDim pn(pt.RowFields.Count)
          For i = 1 To pt.RowFields.Count
             pn(pt.RowFields(i).Position) = pt.RowFields(i).Name   ' store rowfield names in the buffer
          Next i                                                   ' sorted by position
       End If

       If pt.ColumnFields.Count > 0 Then
          ReDim pc(pt.ColumnFields.Count)
          For i = 1 To pt.ColumnFields.Count
             pc(pt.ColumnFields(i).Position) = pt.ColumnFields(i).Name   ' store Columnfield names in the buffer
          Next i                                                      ' sorted by position
       End If

       For i = LBound(pc) To UBound(pc)
          With pt.PivotFields(pc(i))
             .Orientation = xlRowField   ' make all columnfields rowfields
             .Position = i
          End With
       Next i

       For i = LBound(pn) To UBound(pn)
          With pt.PivotFields(pn(i))
             .Orientation = xlColumnField   ' and vice versa
             .Position = i
          End With
       Next i

       Set pt = Nothing
    End Sub


    Function getPivotTable() As PivotTable
       Dim ch           As ChartObject
       On Error Resume Next
      
       Set getPivotTable = ActiveCell.PivotTable                       ' 1. will see whether there is an active pivot table
       If Not getPivotTable Is Nothing Then Exit Function
      
       Set getPivotTable = ActiveChart.PivotLayout.PivotTable   ' 2nd will see whether we have an active pivot chart
       If Not getPivotTable Is Nothing Then Exit Function
      
       Set getPivotTable = ActiveSheet.PivotTables(1)              ' lets see whether there is at least one pivot table on the sheet
       If Not getPivotTable Is Nothing Then Exit Function
      
       Set getPivotTable = ActiveSheet.PivotLayout.PivotTable   '  lets see whether we have an active pivot chart
       If Not getPivotTable Is Nothing Then Exit Function
      
       If ActiveSheet.ChartObjects.Count > 0 Then                    ' or an embedded pivot chart
          For Each ch In ActiveSheet.ChartObjects
             If ch.Chart.HasPivotFields Then
                Set getPivotTable = ch.Chart.PivotLayout.PivotTable
                Exit For
             Else
                Set getPivotTable = Nothing
             End If
          Next ch
       Else                                                       ' done our best to find a pivot table 
          Set getPivotTable = Nothing                  ' this should trigger an error message in the caller now.
       End If
      
    End Function

    Filed under:
    • Post Points: 21
  • Fri, Jan 18 2008 12:08 PM In reply to

    • Roger Govier
    • Top 10 Contributor
    • Joined on Wed, Jan 9 2008
    • Abergavenny, South Wales, UK
    • Posts 58
    • Points 991
    • MVP

    Re: Swapping pivot table row and column fields back and forth, "transpose" a pivottable

    I think you need to set Option Base 1 at the top of the module, otherwise you will get Error 1004 on the sections uisng

    For i = LBound(pc) To UBound(pc)

    Regards Roger Govier Microsoft Excel MVP
    • Post Points: 5
Page 1 of 1 (2 items) | RSS
Copyright Excel User Group and the relevant contributors, 2008. All Trade Marks acknowledged. This site is a peer-to-peer site and NOT affiliated in any way to Microsoft Corp. All rights reserved.