Option Explicit

[Yash0071]

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 <<<

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

 

[Monty]

Having gone through your entir code and problem statment.

It seems like you're working on calculating various portfolio metrics and covariance matrices using VBA.
To optimize weights without Solver, you can implement optimization algorithms like gradient descent or genetic algorithms.
These methods might require more complex coding but can achieve optimization without relying on Solver.

Let me know if you need further assistance with implementing these algorithms.

 

[Yash0071]

optimization algorithms like gradient descent or genetic algorithms and thank you for this. Ill try them. I just want to maximize 1 dependent variable using few constraints and changing variables.

 

[Monty]

Helli Yash

I have started working on gradient descent in VBA to get solution for your problem..let me know... but for sure will take some time..

 

[Yash0071]

Thank you! I also found out what to program. Ill start tomorrow. Only these .application part of code is getting Debug error for all major analysis. Im working round it.

 

[Monty]

Sure, let me know in case if you encounter any challenges

 

[Yash0071]

Hi! I finally started working on Gradient descent which is the first step in finding minimum variance. I've tried Google to find formula and all I can see is Regression based Gradient descent. To start with any formula for that. I read minimization function is -f(x) but stuck from there cause I want a formula which can fit Objective, changing variables and constraints in an equation. Regards.