I learn how to create an VBA progress indicator from j-walk blog after surfing around and finally found the simplest one.
And now I can apply it into my portfolio optimisation model.
The code:
Sub optimise()
Dim PctDone As Single
Application.ScreenUpdating = False
nosim = Range("nosim")
For i = 1 To nosim
Application.DisplayStatusBar = True
Application.StatusBar = "Please be patient..."
Range("simulation").Copy
Range("simmeanresult").Cells(71 + i, 1).PasteSpecial Paste:=xlPasteValues
Count = Count + 1
PctDone = Count / nosim
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
DoEvents
Next i
Unload UserForm1
Application.StatusBar = False
SolverOk SetCell:=Range("tangency"), MaxMinVal:=1, ValueOf:=0, ByChange:=Range("proweight")
SolverAdd CellRef:=Range("proweight"), Relation:=3, FormulaText:="0"
SolverAdd CellRef:=Range("one"), Relation:=2, FormulaText:="100%"
SolverSolve UserFinish:=True
Application.ScreenUpdating = True
End Sub
And now I can apply it into my portfolio optimisation model.
The code:
Sub optimise()
Dim PctDone As Single
Application.ScreenUpdating = False
nosim = Range("nosim")
For i = 1 To nosim
Application.DisplayStatusBar = True
Application.StatusBar = "Please be patient..."
Range("simulation").Copy
Range("simmeanresult").Cells(71 + i, 1).PasteSpecial Paste:=xlPasteValues
Count = Count + 1
PctDone = Count / nosim
With UserForm1
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
DoEvents
Next i
Unload UserForm1
Application.StatusBar = False
SolverOk SetCell:=Range("tangency"), MaxMinVal:=1, ValueOf:=0, ByChange:=Range("proweight")
SolverAdd CellRef:=Range("proweight"), Relation:=3, FormulaText:="0"
SolverAdd CellRef:=Range("one"), Relation:=2, FormulaText:="100%"
SolverSolve UserFinish:=True
Application.ScreenUpdating = True
End Sub
Labels: tips
Post a Comment
<< Home