PF_Allocate (VBA)

Wed, 20 May 2026 04:33:00 +0100

Abstract

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.

Appendix – PF_Allocate Code

Please note that this program needs (calls) UniqRandInt.

Please read my Disclaimer.

Option Explicit
    
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
'Source (EN): http://www.sulprobil.de/pf_allocate_en/
'Source (DE): http://www.berndplumhoff.de/pf_allocate_de/
'(C) (P) by Bernd Plumhoff 26-Jul-2020 PB 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)
    'Source (EN): http://www.sulprobil.de/uniqrandint_en/
    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

Download

Please read my Disclaimer.

PF_Allocate on Sulprobil

PF_Allocate (VBA)

Abstract

Appendix – PF_Allocate Code

Download