I am a supporter of
St. Joseph's hospice.
 If you find this site useful or if it helped you, consider a small donation to
St. Joseph's, please.

Information on
St. Joseph's

JustGiving - Sponsor me now!

 

PF_Allocate
PF_Allocate

If you need to generate random portfolios with a given total sum and lower boundaries and upper boundaries for each asset, you can take the function PF_Allocate() shown below.

Function PF_Allocate(db As Double, _
    vlb As Variant, _
    vub As Variant) As Double()
'Generate a portfolio of assets x1..xN
'x1..xN being random numbers (double) with:
'x1+x2+..xN = db 'budget
'xi >= vlb(i)    'lower bound vector
'xi <= vub(i)    'upper bound vector
'Reverse(moc.liborplus.www) V0.11
Dim i As Variant, n As Long
Dim dcumx As Double
Dim dcumlb As Double
Dim dcumub As Double
Dim dxlb As Double
Dim dxub As Double

Application.Volatile
dcumlb = Application.WorksheetFunction.Sum(vlb)
dcumub = Application.WorksheetFunction.Sum(vub)
If dcumlb > db Or dcumub < db Then
    PF_Allocate = CVErr(xlErrValue)
    Exit Function
End If
n = vlb.Count
ReDim dR(1 To n) As Double
dcumx = 0#
'For i = 1 To n 'Old biased solution
For Each i In VBUniqRandInt(n, n)
    'http://www.sulprobil.com/html/uniqrandint.html
    If vlb(i) > vub(i) Then
        PF_Allocate = CVErr(xlErrValue)
        Exit Function
    End If
    dcumlb = dcumlb - vlb(i)
    dcumub = dcumub - vub(i)
    dxlb = db - dcumx - dcumub
    If dxlb < vlb(i) Then dxlb = vlb(i) 'dxlb = Min(..)
    dxub = db - dcumx - dcumlb
    If dxub > vub(i) Then dxub = vub(i) 'dxub = Max(..)
    dR(i) = dxlb + Rnd() * (dxub - dxlb)
    dcumx = dcumx + dR(i)
Next i
PF_Allocate = dR
End Function

Sulprobil   Get it done   Contact   Disclaimer   Download