Logo 
Search:

MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

Spearman Rank Correlation Matrix

  Asked By: Ella    Date: Sep 14    Category: MS Office    Views: 11692
  

New to VBA, I'm looking to calculate a spearman rank correlation matrix
for 10 columns of data representing Stocks and Bonds. i.e data is
columns A:K with names in row 1 and dates in column A (although
irrelevant for calculation). Has anybody any experience with writing
code that would calculate the correlation coefficient between each pair
and present the returns just like Excels correlation function does. Any
help appreciated.

Share: 

 

1 Answer Found

 
Answer #1    Answered By: Gilberto Thompson     Answered 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

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




Tagged: