'From: rolf.kjoeller@get2net.dk (Rolf Kjoeller) 'Newsgroups: comp.soft-sys.stat.spss 'Subject: rounding of cellfrequencies In crosstables 'Date: Thu, 26 Aug 1999 09:30:20 GMT 'Here Is another take On the round-cellfrequencies-problem. The script 'will Do crazy things On anything but crosstables that contain only 'cellfrequencies, On the positive side it doesn't modify your data ... Option Explicit Sub Main On Error GoTo UserCancel Dim objOutputDoc As ISpssOutputDoc Dim objOutputItems As ISpssItems Dim objOutputItem As ISpssItem Dim objPivotTable As PivotTable Dim objCells As ISpssDataCells Dim strRoundValue As String Dim lngRoundValue As Long, lngSum As Long Dim lngII As Long, lngJJ As Long Dim lngLastRow As Long, lngLastCol As Long Dim intLastItem As Integer strRoundValue = InputBox$("Round-value:","Round cell-frequencies to nearest integer") If strRoundValue = "" Then GoTo UserCancel lngRoundValue = CLng(strRoundValue) 'get the last pivottable: Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc Set objOutputItems = objOutputDoc.Items() With objOutputItems intLastItem = .Count() - 1 For lngII = intLastItem To 0 Step -1 Set objOutputItem = .GetItem(lngII) If objOutputItem.SPSSType = SPSSPivot Then Set objPivotTable = objOutputItem.Activate() objpivottable.UpdateScreen = False Exit For End If Next lngII End With Set objCells = objPivotTable.DataCellArray With objCells lngLastRow = .NumRows - 1 lngLastCol = .NumColumns - 1 'round the datacells: For lngII = 0 To lngLastRow For lngJJ = 0 To lngLastCol If Not IsNull(.ValueAt(lngII, lngJJ)) Then .ValueAt(lngII, lngJJ) = CStr(Format(.ValueAt(lngII, lngJJ)/lngRoundValue, "0") * lngRoundValue) End If Next lngJJ Next lngII 'recalc rowsums: For lngII = 0 To lngLastRow lngSum = 0 For lngJJ = 0 To lngLastCol - 1 If Not IsNull(.ValueAt(lngII, lngJJ)) Then lngSum = lngSum + .ValueAt(lngII, lngJJ) End If Next lngJJ .ValueAt(lngII, lngLastCol) = CStr(lngSum) Next lngII 'recalc colsums: For lngJJ = 0 To lngLastCol lngSum = 0 For lngII = 0 To lngLastRow - 1 If Not IsNull(.ValueAt(lngII, lngJJ)) Then lngSum = lngSum + .ValueAt(lngII, lngJJ) End If Next lngII .ValueAt(lngLastRow, lngJJ) = CStr(lngSum) Next lngJJ End With objOutputItem.Deactivate objOutputDoc.ClearSelection UserCancel: End Sub