Crop and retain

'Begin Description
'This Script allows you to delete all rows in a Pivot Table beyond a cut
'point that you can specify (intNumberRowsToKeep).
'It also allows you to chose a particular row label (strSearchRowToKeep)
'to keep, even if it is below the cut point intNumberRowsToKeep.
'NOTE: In order for this script to work, the "Hide empty rows and columns"
'option in the Table Properties dialog must be checked (if it is not already
'part of your default TableLooks set-up).
'Requirement: The Pivot Table that you want to modify must be selected when running.
'Restriction: This script searches only the first (left-most) column of the Pivot Table.
'By default SPSS generates a variable heading in this column
'which should be ungrouped in output or deselected when generating the table
'End Description
'Mark Baxter & Massimo Centazzo 2002


Option Explicit

Sub Main


	Dim objPivotTable As PivotTable
	Dim objItem As ISpssItem
	
	Dim bolFoundOutputDoc As Boolean
	Dim bolPivotSelected As Boolean
	Dim strSearchRowToKeep As String
	Dim intNumberRowsToKeep As Integer

	'Call GetFirstSelectedPivot to get the selected pivot table. GetFirstSelectedPivot is a
	'global procedure in Global.sbs(the default Global Procedure file)
	Call GetFirstSelectedPivot(objPivotTable, objItem, bolFoundOutputDoc, bolPivotSelected)

	If (bolFoundOutputDoc = False) Or (bolPivotSelected = False) Then
		'either there wasn't an output doc or a pivot table wasn't selected
		Exit Sub
	End If
	
	objPivotTable.ClearSelection

	'Strings you want to search for in Row Labels and Column Labels.
	strSearchRowToKeep = "19"
	'Number of rows we want to keep in the table
	intNumberRowsToKeep = 5


	'Remove a row (or rows) from a PivotTable when the Row Label matches strSearchRowString
	Call RemovRow(objPivotTable, strSearchRowToKeep, intNumberRowsToKeep)
	
	objItem.Deactivate

End Sub


Sub RemovRow(objPivotTable As PivotTable, strSearchString As String, IntMaxNumber As Integer)

	'Declare SPSS object variables
	Dim objRowLabels As ISpssLabels
	
	'Declare other variables used in the procedure
	Dim lngNumRows As Long
	Dim lngNumCols As Long
	Dim lngRowNum As Long
	Dim lngColNum As Long
	
	'assign objects to object variables
	Set objRowLabels = objPivotTable.RowLabelArray
	
	objPivotTable.ClearSelection

	If objRowLabels.NumRows - 1 > IntMaxNumber Then
		'Loop through the RowLabels looking for strSearchString
		For lngRowNum = IntMaxNumber To objRowLabels.NumRows - 1
			For lngColNum = 0 To objRowLabels.NumColumns - 1
				If objRowLabels.ValueAt(lngRowNum, lngColNum) <> strSearchString And _
						objRowLabels.ValueAt(lngRowNum, lngColNum) <> "Rows" Then
					Call DelDataRow(objPivotTable, lngRowNum)
					Exit For
					'Can exit the lngColNum for..next loop because we've deleted data in row
				End If
			Next lngColNum
		Next lngRowNum
	End If

End Sub


Sub DelDataRow(objPivotTable As PivotTable, lngRowToDelete As Long)

	'Declare SPSS objects
	Dim objDataCells As ISpssDataCells
	Dim objPivotMgr As ISpssPivotMgr
 	Dim objDimension As ISpssDimension


	'Declare other variables used in the procedure
	Dim lngColNum As Long
 	Dim intLayerNum As Integer
 	Dim intSaveCategory() As Integer
 	
 	'get the DataCells object and PivotManager object
 	Set objDataCells = objPivotTable.DataCellArray
 	Set objPivotMgr = objPivotTable.PivotManager

	'Loop through all of the DataCells and select any cell with a value that meets the criteria
	For lngColNum = 0 To objDataCells.NumColumns - 1
		If Not IsNull(objDataCells.ValueAt(lngRowToDelete, lngColNum)) Then
			objDataCells.ValueAt(lngRowToDelete, lngColNum) = ""
		End If
	Next lngColNum

End Sub