VBA Rolling Average Pairwise Correlation

Question

I am trying to calculate the rolling average pairwise correlation between a number of assets in excel.

I have created a custom function, and tried using the correlation matrix, but neither are satisfactory.

The assets are located in columns
Correlation must be over the defined time period/lookback
But if data is missing in part of the look back, that asset is ignored (until it has sufficient data)

So far, the function works but I cannot force it to ignore incomplete ranges (it replaces blank with 0):

Function avgRho(DataRange As Range)
'
Dim nRow As Long, nCol As Long
Dim i As Long, j As Long, j1 As Long, j2 As Long
Dim RtnData() As Double
Dim v1
Dim counts As Double, sum_correl As Double
Dim rtn1() As Double, rtn2() As Double
'
avgRho = 0
'
nRow = DataRange.Rows.Count
nCol = DataRange.Columns.Count
If nRow <= 2 Or nCol <= 1 Then Exit Function
'
ReDim RtnData(1 To nRow, 1 To nCol)
ReDim rtn1(1 To nRow)
ReDim rtn2(1 To nRow)
'
For i = 1 To nRow
    For j = 1 To nCol
        v1 = DataRange(i, j).Value
        RtnData(i, j) = v1
    Next j
Next i
'
counts = 0
sum_correl = 0
For j1 = 1 To nCol
'
    For i = 1 To nRow
        rtn1(i) = RtnData(i, j1)
    Next i
'
    For j2 = j1 + 1 To nCol
        For i = 1 To nRow
                rtn2(i) = RtnData(i, j2)
        Next i
'
        counts = counts + 1
        sum_correl = sum_correl + WorksheetFunction.Correl(rtn1, rtn2)
'
    Next j2
'
Next j1
'
If sum_correl > 0 Then avgRho = sum_correl / counts
'
End Function

Please clarify your question. stackoverflow.com/help/how-to-ask — RubberDuck
Not sure I understood the question completely but your code does not filter out empty cells. I think before rtn2(i)= .... and before rtn1(i)= ... you would have to place a condition -> If Not IsEmpty(cell(...)) Then rtn2(i) = OR rtn1(i) = as applicable. Followed by End If, of course. Have I got it correct? — Peekay
thanks @Peekay yes I needed to omit the blanks, and tweak the counting process — user1758908

user1758908 user1758908 · Accepted Answer · 2014-05-21T14:47:35

Solved by doing similar to suggestion, thanks Peekay, filtering out blank cells when adding to the data matrix RtnData Also changed the count process:

Function avgRho(DataRange As Range)
'
Dim nRow As Long, nCol As Long
Dim i As Integer, j As Integer, j1 As Integer, j2 As Integer
Dim RtnData() As Double
Dim v1
Dim counts As Double, sum_correl As Double
Dim rtn1() As Double, rtn2() As Double
Dim MatColCount As Integer
'
avgRho = 0
MatColCount = 0
'
nRow = DataRange.Rows.Count
nCol = DataRange.Columns.Count
If nRow <= 2 Or nCol <= 1 Then Exit Function
'
ReDim RtnData(1 To nRow, 1 To nCol)
ReDim rtn1(1 To nRow)
ReDim rtn2(1 To nRow)
'
For i = 1 To nRow
    MatColCount = 0
    For j = 1 To nCol
        If DataRange(1, j).Value <> "" And DataRange(nRow, j) <> "" Then
            v1 = DataRange(i, j).Value
            MatColCount = MatColCount + 1
            RtnData(i, MatColCount) = v1
        End If
    Next j
Next i
'
counts = 0
sum_correl = 0
If MatColCount <= 1 Then Exit Function
'
For j1 = 1 To MatColCount
    For i = 1 To nRow
        rtn1(i) = RtnData(i, j1)
    Next i
'
    For j2 = j1 + 1 To MatColCount
        For i = 1 To nRow
            rtn2(i) = RtnData(i, j2)
        Next i
'
        counts = counts + 1
        sum_correl = sum_correl + WorksheetFunction.Correl(rtn1, rtn2)
'
    Next j2
'
Next j1
'
If counts > 0 Then avgRho = sum_correl / counts
'
End Function

VBA Rolling Average Pairwise Correlation

1 Answers