1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
'Begin Description
'This script reverses the order of the columns in all frequency tables 
'in the designated output window.
'End Description

'Author:  Tom Dierickx
'Created: 3/27/2001

'PURPOSE
   'As a fast and generalized way to reverse all frequency table columns without 
   'having to do temporary recodes from syntax before every table and without 
   'regard to labels' text or even how many different categories a given table
   'might consist of.

'ASSUMPTIONS
   '"Frequency tables" contain:
   '1) "Total" as the last 2 columns' shared column header
   '2) Consist of any number of 2-column "pairs" (i.e. N and % for each value label)
   '3) There might or might not be a "Not Applicable" (or "No Basis") column next 
   '   to the Totals column

'EFFECTS
   'Reverses the order of all the columns EXCEPT it leaves the Totals column 
   '(and a Not Applicable column) if one exists right before the Totals column

Sub Main()

   'Declare Variables
   Dim objOutputDoc As ISpssOutputDoc        ' Output Document
   Dim objItem As ISpssItem                  ' Output item object
   Dim objPivotTable As PivotTable           ' Pivot Table object
   Dim nItems As Integer                     ' Number of items in the Output Viewer
   Dim i As Integer                          ' Will be used to index row number
   Dim j As Integer                          ' Will be used to index column number
   Dim ColLabels(50) As String               ' Will store original column labels
   Dim CellValue(99, 50) As String           ' Will store original cell values

   'Grab the current Output Document
   Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc

   'Loop through all the output items in the current Output window
   nItems = objOutputDoc.Items.Count
   For index = 0 To nItems - 1

      'Grab the Item
      Set objItem = objOutputDoc.Items.GetItem(index)

      'Check to see if it is a SPSSPivot object.
      If objItem.SPSSType = 5 Then 'SPSSPivot

         'If so, we need to activate it before we can manipulate its contents
         Set objPivotTable = objItem.Activate
         objPivotTable.UpdateScreen = False

         'Determine number of columns and data rows
         NumColLabels = objPivotTable.ColumnLabelArray.NumColumns
         NumRows = objPivotTable.DataCellArray.NumRows

         '*** Assumption: Frequency tables will:
         '1) have the word "Total" In the last column
         '2) contain 3 rows of column labels (note: only 2 of which are visible...)

         If (objPivotTable.ColumnLabelArray.ValueAt(1, NumColLabels - 1) = "Total" And _
             objPivotTable.ColumnLabelArray.NumRows = 3) _
         Then

            'Since we made it this far, we're probably dealing with a frequency table and would like to
            'see if the next to last column is a Not Applicable or No Basis column. If so, it will not move either.
            Select Case UCase(objPivotTable.ColumnLabelArray.ValueAt(1, NumColLabels - 3))
            Case "NOT APPLICABLE", "NO BASIS"
               NumColLabels = objPivotTable.ColumnLabelArray.NumColumns - 2
            End Select

            'Load into temp array Column Labels
            For j = 1 To NumColLabels - 2
               ColLabels(j - 1) = objPivotTable.ColumnLabelArray.ValueAt(1, j - 1)
            Next j

            'Load into temp array Cell Values
            For i = 1 To NumRows
               For j = 1 To NumColLabels - 2
                  CellValue(i - 1, j - 1) = objPivotTable.DataCellArray.ValueAt(i - 1, j - 1)
               Next j
            Next i

            'Now, reverse everything!
            For j = 1 To NumColLabels - 2
               objPivotTable.ColumnLabelArray.ValueAt(1, j - 1) = ColLabels(NumColLabels - 2 - j)
            Next j

            For i = 1 To NumRows
               For j = 1 To (NumColLabels - 2) / 2
                  objPivotTable.DataCellArray.ValueAt(i - 1, 2 * j - 2) = CellValue(i - 1, NumColLabels - 2 - 2 * j)
                  objPivotTable.DataCellArray.ValueAt(i - 1, 2 * j - 1) = CellValue(i - 1, NumColLabels - 2 - 2 * j + 1)
               Next j
            Next i

         End If

         'Let go of the actived Pivot Table
         objItem.Deactivate
         objItem.Expanded = True

         'Refresh the Output document
         objPivotTable.UpdateScreen = True
         objItem.Selected = True: objItem.Activate: objItem.Deactivate: objItem.Selected = False

      End If
   Next index


End Sub