Updating a Script -- can someone please tell me what to do!

Moderators: statman, Analyst Techy, andris, Fierce, GerineL, Smash

JanJordan
Posts: 1
Joined: Fri Jan 16, 2015 2:45 pm

Updating a Script -- can someone please tell me what to do!

Postby JanJordan » Fri Jan 16, 2015 3:04 pm

I recently jumped from SPSS version 13 to version 22. The script I have always used to suppress table statistics in rows with fewer than 5 N is not working. I've made some edits but I know just enough to get myself in trouble. I am posting the script below:

Const CminValue As Integer =5

Sub Main
Dim objOutputDoc As ISpssOutputDoc
Dim objItems As ISpssItems
Dim objItem As ISpssItem
Dim objPivotTable As PivotTable
Dim intCount As Integer
On Error GoTo EH_Main

Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
With objOutputDoc
.ClearSelection
.SelectAllNotes
.Remove
.SelectAllLogs
.Remove
End With
Set objItems = objOutputDoc.Items
intCount=objItems.Count-1
For intItem = 0 To intCount
Set objItem = objItems.GetItem(intItem)
If objItem.SPSSType = SPSSTitle And objItem.Label = "Title" Then objItem.Selected=True
Next 'intItem
objOutputDoc.Remove
intCount=objItems.Count-1
For intItem = 0 To intCount
Set objItem = objItems.GetItem(intItem)
If objItem.SPSSType=SPSSPivot Then
Set objPivotTable = objItem.ActivateTable
objPivotTable.UpdateScreen=False
Call CellSuppression (objPivotTable ,CminValue)
objPivotTable.UpdateScreen=True
objItem.Deactivate
End If
Next 'IntItem
objOutputDoc.ClearSelection
Exit Sub
EH_Main:
Resume Next
End Sub

Sub CellSuppression (objPivot As PivotTable, minValue As Integer)
Dim objColumnLabels As ISpssLabels, objDataCells As ISpssDataCells
Dim CountCols() As Integer
On Error GoTo EH_CellSuppression
ReDim CountCols(0)
CountCols(0) = -1
Set objColumnLabels = objPivot.ColumnLabelArray
Set objDataCells = objPivot.DataCellArray
Dim intNRows As Integer,intNCols As Integer, intCurRow As Integer, intCurCol As Integer
Dim intDataRows As Integer,intNumCounts As Integer
intNRows=objColumnLabels.NumRows-1
intNCols=objColumnLabels.NumColumns-1
intDataRows = objDataCells.NumRows-1

'First Cache the columns which contain Count statistics
For intCurCol = 0 To intNCols
If objColumnLabels.ValueAt(intNrows,intCurCol)="Count" Then
intNumCounts = UBound(CountCols)
If CountCols(0) <> -1 Then
intNumCounts=UBound(CountCols) + 1
ReDim Preserve CountCols(intNumCounts)
End If
CountCols(intNumCounts) = intCurCol
End If
Next 'intCurCol
If CountCols(0) = -1 Then Exit Sub

For intColSeg=0 To intNumCounts
intSeekcol=CountCols(intColSeg)
If intColSeg = intNumCounts Then
intLastColumn=intNCols
Else
intLastColumn = CountCols(intColSeg+1)-1
End If
For intCurRow=0 To intDataRows
With objDataCells
If .ValueAt(intCurRow,intSeekcol) < minValue Then
For intZapCol = intSeekcol+1 To intLastColumn
.ValueAt(intCurRow, intZapCol) = "*"
.HAlignAt(intCurRow, intZapCol) = 1 'SpssAlignRight
Next 'intZapCol
End If
End With
Next 'intCurRow
Next 'intColSeg
Exit Sub
EH_CellSuppression:
Resume Next
End Sub
Analyst Techy
Moderator
Posts: 22
Joined: Mon Apr 27, 2009 2:19 am
Location: Melbourne, Australia

Re: Updating a Script -- can someone please tell me what to

Postby Analyst Techy » Thu Jan 22, 2015 1:34 am

Hi JanJordan

I had a quick look at your code which is very impressive.

I notice that you have not declared all of your variables in your code which is a prerequisite of you Option Explicit declared within your module/unit e.g. these should be possibly declared as follows:
'NEW Menu procedure
Dim intItem As Integer

'NEW Cell Suppression procedure
Dim intColSeg As Integer
Dim intSeekcol As Integer
Dim intLastColumn As Integer
Dim intZapCol As Integer

Also could be a slight difference in the objects library between version 12 and your latest version. Could also be a library referencing problem.
Within the opened script, try the following menu ribbon options Edit>References.

Also with the latest versions of Windows etc you have to be more literal with the calls to objects.

Good luck

Kind regards

Analyst Techy
Analyst Techy

NOTES:
Any solutions I provide on this forum are free of charge, donations go towards the maintenance of the unaffiliated SPSS forum.

Who is online

Users browsing this forum: No registered users and 2 guests

cron