Portfolio Optimization


 

     
 

The objective of this project is to learn how the Nobel Prize winning, Optimal Portfolio Theory (by Harry Markowitz), works in practice. Three stocks are used for this project. The efficient frontier for the three-stock portfolio is plotted on Figure 1

The three-stock portfolio possibilities space is derived by assigning different weights for each stock using a random number generator. The random number generator generated random numbers from 0 to 1. To ensure the sum of the three weights equal 1 and all three weights are positive numbers between 0 to 1, the following procedure is followed:

1. Generate 3 random numbers. 
2. Assign the ith random number divided by the sum of the three random numbers as the weight for stock i. 

The procedure above ensure each weight will be fairly distributed.

Once the portfolio possibilities space is plotted (in purple) , the optimal portfolio could be found by graphically determining the tangency portfolio consistent with the riskless interest rate. The riskless rate (the U.S. T-Bill rate can be used as a proxy) in this case was assumed to be 4%. The expected return and the standard deviation corresponding to the tangency were 12.5% and 20%, respectively.

To let the computer select the optimal portfolio, the Sharpe Ratio is used. In this case, the portfolio corresponding to the largest Sharpe Ratio is the optimal portfolio. Four thousands (4,000) combinations are generated. The largest Sharpe Ratio is found to be 41.315%. The weights corresponding to this ratio are 17.30%, 42.81% and 39.88% for stocks 1, 2 and 3, respectively. The portfolio's expected return and standard deviation were 12.27% and 20.017%, respectively. Note that, for a 3 stock portfolio, 500 combinations would be enough to provide a very good estimate. To set the number of combinations, place the number on cells "E4" of the sheet "Input Sheet". To use this program, the user needs to create the following sheets: "Input Sheet" & "Output Sheet". The user may not need to set up the format as shown in Figures 2 and 3. For those sheets, however, it is very important that the inputs, stock variances, covariances, expected returns, risk free rate, and the number of iterations, be place in the same cell references as in Figure 2.

Figure 1

Figure 2

Figure 3

sp2 = portfolio variance
Wi = weight of stock i
si2 = variance of stock i
Rp = portfolio return
sij2 = covariance of stock i and j
Rf = risk free rate

Option Explicit

'***********************************************************************************
'*                                  Compute the portfolio standard deviation                           *
'***********************************************************************************
Sub PortfSD()
    Dim riskFreeRate As Single
    riskFreeRate = Sheets("Input Sheet").Range("E3").Value
    Dim i As Integer, j As Integer, k As Integer, nLoop As Long
    Dim n As Variant
    Cells(5, 10) = "=count(b7:b16)"
    nLoop = Sheets("Input Sheet").Range("E4").Value
    n = Sheets("Input Sheet").Range("J5").Value
    ReDim Matrix(n, n)
    ReDim rand(n) As Single
    Dim randSum As Single, varSum As Single, meanSum As Single, wSum As Single
    ReDim stkmean(nLoop) As Single, portfMean(nLoop) As Single
    ReDim W(nLoop, n) As Single, sharpeRatio(nLoop) As Single
    ReDim SD(nLoop) As Single, Hold(nLoop) As Single
   
    Call startSetup
    For k = 1 To nLoop                                  'start iteration
   
        varSum = 0
        randSum = 0
        meanSum = 0
        wSum = 0
       
        For i = 1 To n                                  'generate random weight
            rand(i) = Rnd
            randSum = randSum + rand(i)
        Next i
       
        For i = 1 To n
            W(k, i) = rand(i) / randSum
            stkmean(i) = Sheets("Input Sheet").Cells(i + 6, 2).Value
            meanSum = meanSum + W(k, i) * stkmean(i)
        Next i
       
        portfMean(k) = meanSum
       
        For i = 1 To n                                  'read in covariance matrix(row,column)
            For j = i To n
                Matrix(i, j) = Sheets("Input Sheet").Cells(i + 6, j + 2)
            Next j
        Next i
   
        For i = 1 To n                                  'compute the diagonal sum = Wi x Wi x Vari
            varSum = varSum + W(k, i) ^ 2 * Matrix(i, i)
        Next i
  
        For i = 1 To n                                  'compute the other sum = 2 x Wi x Wj x Varij
            For j = i + 1 To n
                varSum = varSum + 2 * W(k, i) * W(k, j) * Matrix(i, j)
            Next j
        Next i
       
        SD(k) = Sqr(varSum)
        sharpeRatio(k) = (portfMean(k) - riskFreeRate) / SD(k)
        Hold(k) = k
       
        Sheets("Output Sheet").Cells(k + 4, 10) = SD(k)
        Sheets("Output Sheet").Cells(k + 4, 11) = portfMean(k)
        Sheets("Output Sheet").Cells(k + 4, 12) = sharpeRatio(k)
    Next k
   
        Call DoubleSort(nLoop, sharpeRatio, Hold)
        Sheets("Output Sheet").Cells(4, 3) = nLoop
        Sheets("Output Sheet").Cells(4, 4) = sharpeRatio(nLoop)
        Sheets("Output Sheet").Cells(4, 5) = portfMean(Hold(nLoop))
        Sheets("Output Sheet").Cells(4, 6) = SD(Hold(nLoop))
       
        For i = 1 To n
            wSum = wSum + W(Hold(nLoop), i)
            Sheets("Output Sheet").Cells(i + 4, 1) = i
            Sheets("Output Sheet").Cells(n + 5, 1) = "Sum Check"
            Sheets("Output Sheet").Cells(i + 4, 2) = W(Hold(nLoop), i)
            Sheets("Output Sheet").Cells(n + 5, 2) = wSum
        Next i
    Call endSetup
End Sub


'***********************************************************************************
'*                                           Sort array y based on array x                                         *
'***********************************************************************************
Sub DoubleSort(n As Long, x() As Single, y() As Single)
    Dim xTemp As Double
    Dim yTemp As Double
    Dim i As Long
    Dim j As Long
   
    For j = 2 To n
        xTemp = x(j)
        yTemp = y(j)
        For i = j - 1 To 1 Step -1
            If (x(i) <= xTemp) Then GoTo 10
            x(i + 1) = x(i)
            y(i + 1) = y(i)
        Next i
        i = 0
10      x(i + 1) = xTemp
        y(i + 1) = yTemp
    Next j
End Sub

'***********************************************************************************
'*                                                     Clear the output area                                           *
'***********************************************************************************
Sub startSetup()
    Sheets("Output Sheet").Select
    Range("C4:F4").Select
    Selection.ClearContents
   
    Range("A5:B100").Select
    Selection.ClearContents
   
    Range("J5:L60000").Select
    Selection.ClearContents
   
    Sheets("Input Sheet").Select
    Range("A1").Select
End Sub

'***********************************************************************************
'*                                                     Go to Output Page                                                 *
'***********************************************************************************

Sub endSetup()
    Sheets("Output Sheet").Select
    Range("A1").Select
End Sub

VBA Codes