'#Language "WWB-COM" 'Begin Description 'This code ' removes the Upper diagonal of the correlation matrix ' highlights significant correlations ' moves the statistics to the Layer dimension (thus hiding N's and Sig's) 'Instructions: Replace the Sub Correlations_Table_Correlations_Create by the Subs and Function below. 'Author: Ferd Britton 2003/08/08 'Adapted for version IBM SPSS Statistics 23.0 by Anton Balabanov, 18.06.2016 '(you will need to link to this script in SPSS Edit...Options menu, Scripts tab: ' enable autoscripting, and select Correlations, and Correlations Table, then link to a file) 'End Description Option Explicit Sub Main 'Autoscript 'Trigger Event: Correlations Table Creation after running Correlations procedure. Dim lngVarGroup As Long 'keeps track of how many rows in a variable group Dim i, intCount As Integer Dim objOutputItem As ISpssItem Dim objCorrPivotTable As PivotTable Dim objDataCells As ISpssDataCells Dim objmanager As ISpssPivotMgr Dim objRow As ISpssDimension Set objOutputItem = scriptContext.GetOutputItem() Set objCorrPivotTable = objOutputItem.ActivateTable Set objDataCells = objCorrPivotTable.DataCellArray If (objDataCells.NumRows Mod objDataCells.NumColumns) = 0 Then 'Set flag so that screen is not updated while we make changes 'NOTE:THIS MUST BE SET BACK TO TRUE AT THE END OF THE AUTOSCRIPT objCorrPivotTable.UpdateScreen = False lngVarGroup = GetVarGroupSize(objCorrPivotTable) 'if -1 then couldn't determine group size If lngVarGroup <> -1 Then 'Procedure that removes upper diagonal of correlation matrix Call RemoveUpperDiag(objCorrPivotTable,objDataCells,lngVarGroup) 'Procedure that highlights significant correlations Call HighlightSigCorr(objCorrPivotTable, objDataCells, lngVarGroup) End If 'Set flag so that screen is updated so we can view changes End If Set objmanager =objCorrPivotTable.PivotManager intCount = objmanager.NumRowDimensions For i = 0 To intCount -1 Set objRow = objmanager.RowDimension(i) If objRow.DimensionName = "Statistics" Then objRow.MoveToLayer(0) Exit For End If Next i objCorrPivotTable.UpdateScreen = True End Sub Sub RemoveUpperDiag(objPivotTable As PivotTable, objDataCells As ISpssDataCells, lngVarGroupSize As Long) 'Purpose: Removes the upper diagonal of a correlation matrix Pivot Table. 'Assumptions: The correlations Pivot Table is already activated 'Effects: Hides all data cells on or above the diagonal in the correlation, significance, ' and N matrices of a Correlations Pivot Table 'Inputs: Correlations Pivot Table, DataCells for Correlations Pivot Table, lngVarGroupSize ' determines how many rows until repeat labels 'Return Values: Reformatted Correlations Pivot Table Dim lngRowNum As Long Dim lngColNum As Long Dim lngNumCols As Long Dim lngNumRows As Long 'Get number of rows and columns in Pivot Table lngNumCols = objDataCells.NumColumns lngNumRows = objDataCells.NumRows 'This loop selects all cells above the diagonal in the correlation, significance, and N matrices For lngRowNum = 0 To lngNumRows - 1 For lngColNum = 0 To lngNumCols - 1 If (lngColNum >= ((Int(lngRowNum/lngVarGroupSize)) Mod lngNumCols)) Then objDataCells.SelectCellAt(lngRowNum, lngColNum) End If Next lngColNum Next lngRowNum 'Now hide all the cells that were selected objPivotTable.TextHidden = True 'Deselect all the cells that had been selected objPivotTable.ClearSelection End Sub Sub HighlightSigCorr(objPivotTable As PivotTable, objDataCells As ISpssDataCells, lngVarGroupSize As Long) 'Purpose: Highlights significant correlations 'Assumptions: The correlations Pivot Table is already activated 'Effects: Changes the background color for cells in correlation matrix that are significant. 'Inputs: Correlations Pivot Table, DataCells for Correlations Pivot Table, lngVarGroupSize ' determines how many rows until repeat labels 'Return Values: Pivot Table with significant correlations highlighted. Dim lngRowNum As Long Dim lngColNum As Long Dim lngNumCols As Long Dim lngNumRows As Long Dim lngColor As Long Dim sngSigLevel As Single Dim bolCellsSelected As Boolean bolCellsSelected = False Set objDataCells = objPivotTable.DataCellArray() 'Obtain Dimensions of Correlation Pivot Table. lngNumCols = objDataCells.NumColumns lngNumRows = objDataCells.NumRows 'Set the value for the Background Color. lngColor = RGB (255, 255, 128) 'Yellow 'Set Significance Level. sngSigLevel = .01 'Loop through Pivot Table. Change the color of the current cell conditional upon the 'value of the element lngNumCols below it. The cells to be changed are selected using 'the SelectCellAt method. The color is changed afterwards with the BackgroupColorAt 'Property. For lngRowNum = 0 To lngNumRows - 1 Step lngVarGroupSize For lngColNum = 0 To lngNumCols - 1 If (lngColNum < ((Int(lngRowNum/lngVarGroupSize)) Mod lngNumCols)) Then If objDataCells.ValueAt(lngRowNum + 1, lngColNum)< sngSigLevel Then objDataCells.SelectCellAt(lngRowNum, lngColNum) bolCellsSelected = True End If End If Next lngColNum Next lngRowNum 'Change the Background Color of the Selected Cells. If bolCellsSelected = True Then objPivotTable.BackgroundColor = lngColor End If End Sub Function GetVarGroupSize(objPivotTable As Object) As Long 'Purpose: To get the number of rows per variable in the correlation table 'Assumptions: The correlations Pivot Table is already activated 'Effects: None 'Inputs: Correlations Pivot Table 'Return Values: The number of rows in each group. Const FIRST_ROW As Long = 0 Dim objRowLabels As ISpssLabels Dim lngRowNum As Long Dim strFirstRowLabel As String Dim lngLastCol As Long Dim bolFoundMatch As Boolean Set objRowLabels = objPivotTable.RowLabelArray lngLastCol = objRowLabels.NumColumns - 1 strFirstRowLabel = CStr(objRowLabels.ValueAt(FIRST_ROW,lngLastCol)) bolFoundMatch = False 'Try to find matching label to first row label -- that will give group size For lngRowNum = FIRST_ROW+1 To objRowLabels.NumRows - 1 If CStr(objRowLabels.ValueAt(lngRowNum,lngLastCol)) = strFirstRowLabel Then bolFoundMatch = True Exit For End If Next lngRowNum If bolFoundMatch Then GetVarGroupSize = lngRowNum Else GetVarGroupSize = -1 End If End Function