Hello Experts,
I have 100 shares data and their % changes in Sheet 1. I want portfolio analysis including optimization of weights. I need solver performed optimal weights to maximize returns. Is there any VBA code please to perform the above without using Solver. I have data for 250 daily prices and need daily & total Portfolio Variance, SD, Sharpe Ratio and any other metrics necessary like Returns in Sheet 2 from below D1 onwards. This is for without a risk free asset.
Regards
I have succeeded to find normal P Variance, SD, Sharpe ratio but not Solver optimization and the code is very lengthy to my surprise. Portfolio variance code not working so Used (MMULT(TRANSPOSE()) on Matrix.
>>> use code - tags <<<
I have 100 shares data and their % changes in Sheet 1. I want portfolio analysis including optimization of weights. I need solver performed optimal weights to maximize returns. Is there any VBA code please to perform the above without using Solver. I have data for 250 daily prices and need daily & total Portfolio Variance, SD, Sharpe Ratio and any other metrics necessary like Returns in Sheet 2 from below D1 onwards. This is for without a risk free asset.
Regards
I have succeeded to find normal P Variance, SD, Sharpe ratio but not Solver optimization and the code is very lengthy to my surprise. Portfolio variance code not working so Used (MMULT(TRANSPOSE()) on Matrix.
>>> use code - tags <<<
Code:
Sub CalculateAllMetricsAndCovarianceMatrix()
Dim ws As Worksheet
Dim i As Long
Dim countDays As Long
' Set the worksheet where your data is located
Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your actual sheet name
' Autofill the percentage change formula in column F ws.Range("F3:F251").Formula = "=(B3-B2)/B2" ' Loop through the range C2:E251 For i = 3 To 251 ws.Cells(i, 7).Formula = "=(C" & i & "-C" & (i - 1) & ")/C" & (i - 1)
ws.Cells(i, 8).Formula = "=(D" & i & "-D" & (i - 1) & ")/D" & (i - 1)
ws.Cells(i, 9).Formula = "=(E" & i & "-E" & (i - 1) & ")/E" & (i - 1)
Next i
' Count the number of cells in column A that contain numbers
countDays = Application.WorksheetFunction.Count(ws.Range("A2:A251"))
' Display the count in cell Q2 ws.Range("Q2").Value = countDays
' Calculate additional metrics (as requested)
ws.Range("L3").Formula = "=AVERAGE(F3:F251)"
ws.Range("M3").Formula = "=AVERAGE(G3:G251)"
ws.Range("N3").Formula = "=AVERAGE(H3:H251)"
ws.Range("O3").Formula = "=AVERAGE(I3:I251)"
ws.Range("L4").Formula = "=STDEV(F3:F251)"
ws.Range("M4").Formula = "=STDEV(G3:G251)"
ws.Range("N4").Formula = "=STDEV(H3:H251)"
ws.Range("O4").Formula = "=STDEV(I3:I251)"
ws.Range("L5").Formula = "=P2*L3"
ws.Range("M5").Formula = "=P2*M3"
ws.Range("N5").Formula = "=P2*N3"
ws.Range("O5").Formula = "=P2*O3"
ws.Range("L6").Formula = "=SQRT(P2*L4)"
ws.Range("M6").Formula = "=SQRT(P2*M4)"
ws.Range("N6").Formula = "=SQRT(P2*N4)"
ws.Range("O6").Formula = "=SQRT(P2*O4)"
ws.Range("L9").Formula = "=Q13"
ws.Range("M9").Formula = "=Q14"
ws.Range("N9").Formula = "=Q15"
ws.Range("O9").Formula = "=Q16"
ws.Range("L10").Formula = "=SQRT(L6)*P2"
ws.Range("M10").Formula = "=SQRT(M6)*P2"
ws.Range("N10").Formula = "=SQRT(N6)*P2"
ws.Range("O10").Formula = "=SQRT(O6)*P2"
ws.Range("L11").Formula = "=CORREL(F3:F251,G3:G251)"
ws.Range("M11").Formula = "=CORREL(F3:F251,H3:H251)"
ws.Range("N11").Formula = "=CORREL(F3:F251,I3:I251)"
ws.Range("O11").Formula = "=CORREL(G3:G251,H3:H251)"
ws.Range("P11").Formula = "=CORREL(G3:G251,I3:I251)"
ws.Range("Q11").Formula = "=CORREL(H3:H251,I3:I251)"
End Sub
Sub ComputeCovarianceMatrix()
' Define your input data range (adjust as needed)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
' Change "Sheet1" to your actual sheet name
' Compute the individual components ws.Range("L13").Formula = "=L10^2"
ws.Range("M13").Formula = "=L10*M10*L11"
ws.Range("N13").Formula = "=L10*N10*M11"
ws.Range("O13").Formula = "=L10*O10*N11"
ws.Range("L14").Formula = "=M13"
ws.Range("M14").Formula = "=M10^2"
ws.Range("N14").Formula = "=M10*N10*O11"
ws.Range("O14").Formula = "=M10*O10*P11"
ws.Range("L15").Formula = "=N13"
ws.Range("M15").Formula = "=N14"
ws.Range("N15").Formula = "=N10^2"
ws.Range("O15").Formula = "=N10*O10*Q11"
ws.Range("L16").Formula = "=O13"
ws.Range("M16").Formula = "=O14"
ws.Range("N16").Formula = "=O15"
ws.Range("O16").Formula = "=O10^2"
' Create the covariance matrix Dim rngCovMatrix As Range
Set rngCovMatrix = ws.Range("L13:O16") rngCovMatrix.Select
End Sub
Sub CalculatePortfolioVariance()
Dim CovMat As Range
Dim Weights As Range
Dim Port_Vol As Double
Dim i As Long, j As Long
Dim n As Long
' Assuming covariance matrix is in L13:O16 and portfolio weights are in Q13:Q16
Set CovMat = Range("L13:O16")
Set Weights = Range("Q13:Q16")
' Get the number of assets (rows/columns in covariance matrix) n = CovMat.Rows.Count
' Calculate portfolio variance using covariance matrix and weights
Port_Vol = 0 For i = 1 To n For j = 1 To n Port_Vol = Port_Vol + Weights(i, 1) * Weights(j, 1) * CovMat(i, j) Next j Next i ' T
Take the square root to get portfolio standard deviation Port_Vol = Sqr(Port_Vol)
' Display the result in cell L18 Range("L18").Value = Port_VolEnd SubSub CalculateAndDisplayResults()
' Assuming the formulas are in cells L18, L19, L20, and L21
' Modify the cell references as needed
' Calculate square root of L18 and display in L19 Range("L19").Formula = "=SQRT(L18)"
' Calculate SUMPRODUCT of L5:O5 and L9:O9 and display in L20 Range("L20").Formula = "=SUMPRODUCT(L5:O5, L9:O9)" ' Calculate L20 divided by L19 and display in L21 Range("L21").Formula = "=L20 / L19"
End Sub
Last edited by a moderator: