Saturday, February 2, 2013

VBA: Covariance Matrix 2


Here is the second attempt in programming the covariance matrix. I still have problems with getting the returns and dynamic averages.


Sub COV2M()

    Dim ws As Worksheet
    Set ws = Sheets.Add
        
    ws.Range("A1") = "Covariance Matrix"

    ws.Range("A3") = "Prices:"
    
    'prices
    p = Worksheets("Sheet1").Range("B2:K100")
    
    'counting rows and columns
    r = Worksheets("Sheet1").Range("B2:K100").Rows.Count
    c = Worksheets("Sheet1").Range("B2:K100").Columns.Count
    
    'pasting price to ws
    ws.Range("A5").Select
    Set ans = ActiveCell.Range(Cells(1, 1), Cells(r, c))
    ans.Value = p
    
    'Returns
    ws.Range("M3") = "Returns"
        
    'rows of return
    r = r - 1
    
    ret = Range("M6:V103")
    For i = 1 To r
        For j = 1 To c
            ret(i, j) = p(i + 1, j) / p(i, j) - 1
        Next j
    Next i
    Range("M6:V103") = ret
    
    'getting the averages
    ws.Range("X3") = "Average"
    ave = ws.Range("X6:AG6")
    For j = 1 To c
        s = 0
        For i = 1 To r
            s = ret(i, j) + s
        Next i
        ave(1, j) = s / r
    Next j
    ws.Range("X6:AG6") = ave
    
    'getting the mean Returns
    ws.Range("AI3") = "Mean Returns"
    mret = ws.Range("AI6:AR103")
    For i = 1 To r
        For j = 1 To c
            mret(i, j) = ret(i, j) - ave(1, j)
        Next j
    Next i
    ws.Range("AI6:AR103") = mret
    
    'getting the covariance matrix
    ws.Range("AT3") = "Covariance"
    trans = Application.WorksheetFunction.Transpose(mret)
    covm = Application.WorksheetFunction.MMult(trans, mret)
    For i = 1 To c
        For j = 1 To c
            covm(i, j) = covm(i, j) / (r - 1)
        Next j
    Next i
    
    Range("AT6").Select
    Set ans = ActiveCell.Range(Cells(1, 1), Cells(c, c))
    ans.Value = covm
    
End Sub

No comments:

Post a Comment