Automation of pivotting

'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 
'--------------------------------------------------------