'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