'Solution ID: 100008929 'Product: SPSS Base 'Title:Automation of Pivoting 'Description:. 'I know how to reformat a particular Pivot Table manually, double-clicking to activate the 'table and dragging a Dimension icon such as "Statistics" or "Variables" in the Pivoting Tray. 'Now, can I do the same thing with a script? 'A. 'The subroutine "PivotDimensionByName" should simplify this. 'Save the portion indicated below to a Text file named, for example, "PivotDimensionByNameDemo.sbs". 'Create a PivotTable with a "Statistics" dimension, e.g. using Correlations or GLM. select it. 'Either open the "PivotDimensionByNameDemo.sbs" file in a script window and run it from there, 'or use Utilities->Run Script To Execute it. 'The subroutine can be called with any dimension name, and will search layers, rows, columns, 'or all dimensions. When it finds the dimension, it will pivot it to layers, rows, or columns, 'placing it first, last, or at a specified position. 'Modify the existing Sub Main or create your own to apply the desired pivoting to pivot tables 'as you see fit. 'Sub Main is intended only to demo PivotDimensionByName 'Call subroutine PivotDimensionByName with parameter values: ' objPivot: activated pivot table ' strDimensionName: text name of dimension to be pivoted ' intFrom: where to look for dimension ' intTo: where to pivot dimension to ' intPosition: put the dimension at the location before this 'use constants PVT_LayerDimension, PVT_RowDimension, ' PVT_ColumnDimension, PVT_AnyDimension for intFrom and intTo; ' PVT_MoveDimensionFirst, PVT_MoveDimensionLast for intPosition Sub Main Dim objPivot As PivotTable, objItem As ISpssItem Dim intPos As Integer 'intPos = PVT_MoveDimensionFirst intPos = PVT_MoveDimensionLast 'intPos = 1000 'illegal value - will be ignored 'this is just to get a Pivot Table to work with GetFirstSelectedPivot objPivot, objItem, True, True If objPivot Is Nothing Then Exit Sub PivotDimensionByName objPivot, "Statistics", _ PVT_AnyDimension, PVT_LayerDimension, intPos ForceItemUpdate objItem MsgBox "Did it pivot to Layers?", vbQuestion Set objPivot = objItem.ActivateTable PivotDimensionByName objPivot, "Statistics", _ PVT_LayerDimension, PVT_RowDimension, intPos ForceItemUpdate objItem MsgBox "Did it pivot to Rows?", vbQuestion Set objPivot = objItem.ActivateTable PivotDimensionByName objPivot, "Statistics", _ PVT_ColumnDimension, PVT_RowDimension, intPos ForceItemUpdate objItem MsgBox "Did it pivot to Rows?", vbQuestion End Sub 'Discard Sub Main; do not copy into your own scripts! 'add the following subroutines to your own scripts: ' PivotDimensionByName, ' DoPivotDimension, ' FindLayerDimension, ' FindRowDimension, ' FindColumnDimension, ' ForceItemUpdate, ' and associated constants ' '-------------------------------------------------------- 'BEGIN subroutines associated with PivotDimensionByName '-------------------------------------------------------- 'CONSTANTS used by PivotDimensionByName subroutine '---- call PivotDimensionByName with intFrom and intTo ' parameters equal to one of the following: Const PVT_LayerDimension As Integer = 0 Const PVT_RowDimension As Integer = 1 Const PVT_ColumnDimension As Integer = 2 Const PVT_AnyDimension As Integer = 3 '---- call PivotDimensionByName with intPosition ' parameter equal to one of the following, ' or a non-negative integer giving the intended position: Const PVT_MoveDimensionFirst As Integer = -1 Const PVT_MoveDimensionLast As Integer = -2 '-------------------------------------------------------- 'Call subroutine PivotDimensionByName with parameter values: ' objPivot: activated pivot table ' strDimensionName: text name of dimension to be pivoted ' intFrom: where to look for dimension ' intTo: where to pivot dimension to ' intPosition: put the dimension at the location ' before this value '-------------------------------------------------------- Sub PivotDimensionByName ( _ objPivot As PivotTable, _ strDimensionName As String, _ intFrom As Integer, _ intTo As Integer, _ intPosition As Integer) Dim objDim As ISpssDimension Dim objPivotMgr As ISpssPivotMgr Dim i As Long Dim intNumDim As Integer Set objPivotMgr = objPivot.PivotManager Select Case intFrom Case PVT_LayerDimension Set objDim = FindLayerDimension(objPivotMgr, strDimensionName) Case PVT_RowDimension Set objDim = FindRowDimension(objPivotMgr, strDimensionName) Case PVT_ColumnDimension Set objDim = FindColumnDimension(objPivotMgr, strDimensionName) Case PVT_AnyDimension Set objDim = FindLayerDimension(objPivotMgr, strDimensionName) If objDim Is Nothing Then Set objDim = FindRowDimension(objPivotMgr, strDimensionName) End If If objDim Is Nothing Then Set objDim = FindColumnDimension(objPivotMgr, strDimensionName) End If Case Else 'trap errors while debugging 'If Err Then MsgBox Err.Description, vbExclamation, "Error " & Err End Select intNumDim = NumDimensions(objPivotMgr, intTo) Select Case intPosition Case PVT_MoveDimensionFirst DoPivotDimension objDim, intTo, 0 Case PVT_MoveDimensionLast DoPivotDimension objDim, intTo, intNumDim Case 0 To intNumDim If Not (objDim Is Nothing) Then DoPivotDimension objDim, intTo, intPosition End If Case Else 'do nothing End Select End Sub '-------------------------------------------------------- ' subroutine associated with PivotDimensionByName '-------------------------------------------------------- Sub DoPivotDimension( _ objDim As ISpssDimension, _ intTo As Integer, intPosition As Integer) Dim intNumDimensions As Integer If objDim Is Nothing Then Exit Sub On Error Resume Next Select Case intTo Case PVT_LayerDimension objDim.MoveToLayer intPosition Case PVT_RowDimension objDim.MoveToRow intPosition Case PVT_ColumnDimension objDim.MoveToColumn intPosition Case Else Debug.Print "Unexpected Dimension type!" End Select 'trap errors while debugging 'If Err Then MsgBox Err.Description, vbExclamation, "Error " & Err End Sub '-------------------------------------------------------- ' function associated with PivotDimensionByName '-------------------------------------------------------- 'returns an SPSS Dimension object 'returns Nothing if name not found '-------------------------------------------------------- Function FindLayerDimension( _ objPivotMgr As ISpssPivotMgr, _ strDimensionName As String) As ISpssDimension Dim objDim As ISpssDimension Dim i As Long With objPivotMgr For i = .NumLayerDimensions - 1 To 0 Step -1 Set objDim = .LayerDimension(i) If objDim.DimensionName = strDimensionName Then Exit For End If Next End With Set FindLayerDimension = objDim End Function '-------------------------------------------------------- ' function associated with PivotDimensionByName '-------------------------------------------------------- 'returns an SPSS Dimension object 'returns Nothing if name not found '-------------------------------------------------------- Function FindRowDimension( _ objPivotMgr As ISpssPivotMgr, _ strDimensionName As String) As ISpssDimension Dim objDim As ISpssDimension Dim i As Long With objPivotMgr For i = .NumRowDimensions - 1 To 0 Step -1 Set objDim = .RowDimension(i) If objDim.DimensionName = strDimensionName Then Exit For End If Next End With Set FindRowDimension = objDim End Function '-------------------------------------------------------- ' function associated with PivotDimensionByName '-------------------------------------------------------- 'returns an SPSS Dimension object 'returns Nothing if name not found '-------------------------------------------------------- Function FindColumnDimension( _ objPivotMgr As ISpssPivotMgr, _ strDimensionName As String) As ISpssDimension Dim objDim As ISpssDimension Dim i As Long With objPivotMgr For i = .NumColumnDimensions - 1 To 0 Step -1 Set objDim = .ColumnDimension(i) If objDim.DimensionName = strDimensionName Then Exit For End If Next End With Set FindColumnDimension = objDim End Function '-------------------------------------------------------- ' function associated with PivotDimensionByName '-------------------------------------------------------- 'returns an integer giving the number of dimensions 'returns 0 if called with inappropriate parameters '-------------------------------------------------------- Function NumDimensions( _ objPivotMgr As ISpssPivotMgr, _ intDimension As Integer) As Integer Dim intNum As Integer On Error Resume Next With objPivotMgr Select Case intDimension Case PVT_LayerDimension intNum = .NumLayerDimensions Case PVT_RowDimension intNum = .NumRowDimensions Case PVT_ColumnDimension intNum = .NumColumnDimensions Case Else 'defaults to 0 End Select End With NumDimensions = intNum End Function '-------------------------------------------------------- ' subroutine associated with PivotDimensionByName '-------------------------------------------------------- ' Call this if PivotTable appearance is not correct ' until redrawn - should not be necessary but often is. '-------------------------------------------------------- Sub ForceItemUpdate(objItem As ISpssItem) With objItem .Deactivate .Activate .Deactivate End With End Sub '-------------------------------------------------------- 'END * subroutines associated with PivotDimensionByName '--------------------------------------------------------