Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Ella Campbell   on Sep 14 In MS Office Category.

  
Question Answered By: Gilberto Thompson   on Sep 14

Here's something that should help get you started. I assume that
you've used Excel to do the calculations via the spreadsheet and just
need help with VB terminology and some 'how to get data  into arrays, etc"

This is not a function; because you have multiple columns, you need
multiple 'outputs', which a function  doesn't do. So, you either need
to have multiple calls to a function, or do the matrix  in one shot,
which is what I've started for you.

I'm not that familiar with the Spearman rank correlation, so I've not
done the complete calculation  - you can finish it.

To use it: select the upper left data cell (not heading). This macro
assumes that the data is contiguous; it doesn't do any error checking
for 'bad' data. Since it writes over existing data (but replaces it at
the end), it'd be best to have a backup of the data

Sub Exer()

Dim Rank() 'hold integers for convience

'save where you started
UserCell = ActiveCell.Address
UserCol = ActiveWindow.ScrollColumn
UserRow = ActiveWindow.ScrollRow
DataSheet = ActiveSheet.Name

'determine range of table
FirstRow = ActiveCell.Row
FirstCol = ActiveCell.Column
LastRow = Selection.End(xlDown).Row
LastCol = Selection.End(xlToRight).Column

'fill Rank with integers
ReDim Rank(1 To LastRow - FirstRow + 1, 1 To 1)
For i = 1 To LastRow - FirstRow + 1
Rank(i, 1) = i
Next i

'save data in an array. One alternative is to copy and past to
another sheet. Record a macro to see how
TheData = Range(Cells(FirstRow, FirstCol), Cells(LastRow,
LastCol)).Value

'sort each column  to get rank of data, and replace data with rank
For c = FirstCol To LastCol
'need to save data that will be overwritten with Rank integers
TempData = Range(Cells(FirstRow, c + 1), Cells(LastRow, c +
1)).Value
Range(Cells(FirstRow, c + 1), Cells(LastRow, c + 1)).Value = Rank
'sort
Range(Cells(FirstRow, c), Cells(LastRow, c + 1)).Select
Selection.Sort Key1:=Cells(LastRow, c), Order1:=xlAscending,
Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'replace sorted col with rank and written over col with
original data
TempRank = Range(Cells(FirstRow, c + 1), Cells(LastRow, c +
1)).Value
For j = 1 To LastRow - FirstRow + 1
Cells(FirstRow + TempRank(j, 1) - 1, c).Value = j
Next j
Range(Cells(FirstRow, c + 1), Cells(LastRow, c + 1)).Value =
TempData
Next c

'put ranks into array
TheRanks = Range(Cells(FirstRow, FirstCol), Cells(LastRow,
LastCol)).Value

'get sheet to place results
Worksheets.Add
OutSheet = ActiveSheet.Name

'calc coeff
For i = 1 To LastCol - FirstCol + 1
For j = i + 1 To LastCol - FirstCol + 1
SumDiffSqr = 0
For k = 1 To LastRow - FirstRow + 1
SumDiffSqr = SumDiffSqr + (TheRanks(k, i) -
TheRanks(k, j)) * (TheRanks(k, i) - TheRanks(k, j))
Next k
Cells(i, j).Value = SumDiffSqr
Next j
Next i


'put back original data
Sheets(DataSheet).Activate
Range(Cells(FirstRow, FirstCol), Cells(LastRow, LastCol)).Value =
TheData
'put back cursor
Range(UserCell).Select
ActiveWindow.ScrollColumn = UserCol
ActiveWindow.ScrollRow = UserRow
End Sub

Share: 

 
 
Didn't find what you were looking for? Find more on Spearman Rank Correlation Matrix Or get search suggestion and latest updates.


Tagged: