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.

sbRebalancedReturn (VBA)

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

Abstract

Portfolio rebalancing is the process of bringing the different asset classes back into proper relationship following a significant change in one or more assets. You return your portfolio to the proper mix of stocks, bonds, cash or other assets when they no longer conform to your plan/limits.

An example:

Appendix – sbRebalancedReturn Code

Please read my Disclaimer.

Option Explicit

Const CMaxDouble = 1.79769313486231E+308
Function sbRebalancedReturn(rARM As Range, _
    rIWV As Range, _
    Optional ByVal lRF As Long = 0, _
    Optional dDT As Double = CMaxDouble) As Variant
'RebalancedReturn calculates balanced returns for a
'portfolio with given
'rARM - asset return matrix (columns show different
'       assets, rows show returns per asset over time)
'rIWV - initial weight vector for the assets
'lRF  - rebalancing frequency (in time steps = rows)
'       If lRF > 0 then each lRF time step rebalancing
'       will take place
'       If lRF = 0 then no rebalancing will take place
'       If lRF < 0 then each -lRF time step after last
'       rebalance portfolio will be rebalanced again
'dDT  - drift tolerance %, if any asset has drifted by
'       by more than dDT (relative measure) then the
'       portfolio will be rebalanced AND the internal
'       rebalancing frequency count will be reset
'The output matrix shows portfolio returns % in first
'column, then end-of-period asset weights and finally
'boolean output values in last column, showing whether
'a rebalance happened.
'This function has been inspired by Andreas Steiner's
'similar function.
'Source (EN): http://www.sulprobil.de/sbrebalancedreturn_en/
'Source (DE): http://www.berndplumhoff.de/sbrebalancedreturn_de/
'(C) (P) by Bernd Plumhoff 19-Mar-2011 PB V0.2
Dim i As Long, j As Long, k As Long, n As Long, m As Long
Dim bDrifted As Boolean, bForceRB As Boolean

n = rARM.Rows.Count 'Number of observations
m = rARM.Columns.Count 'Number of assets

If m <> rIWV.Columns.Count Or _
    rIWV.Rows.Count <> 1 Then
    sbRebalancedReturn = CVErr(xlErrValue)
    Exit Function
End If

ReDim w0(1 To m) As Double, x(1 To m) As Double
ReDim r(1 To n, 1 To m) As Double

If lRF = 0 Then lRF = n
If lRF < 0 Then
    lRF = -lRF
    bForceRB = True
Else
    bForceRB = False
End If

ReDim vR(1 To n, 1 To m + 2)
For i = 1 To m
    x(i) = rIWV(i)
    w0(i) = x(i)
    For j = 1 To n
        r(j, i) = rARM(j, i)
    Next j
Next i

k = 1
'Model rebalancing tolerance
For i = 1 To n
    If bDrifted And bForceRB Then k = i
    'Calculate period start weights
    vR(i, m + 2) = (i - k) Mod lRF = 0 Or bDrifted
    If vR(i, m + 2) Then
        For j = 1 To m
            x(j) = w0(j)
        Next j
    Else
        For j = 1 To m
            x(j) = vR(i - 1, 1 + j)
        Next j
    End If
    'Calculate portfolio return
    For j = 1 To m
        vR(i, 1) = vR(i, 1) + x(j) * r(i, j)
    Next j
    'Calculate period end weights & check for drift
    bDrifted = False
    For j = 1 To m
        vR(i, 1 + j) = x(j) * (1# + r(i, j)) / (1# + vR(i, 1))
        bDrifted = bDrifted Or Abs(vR(i, 1 + j) - w0(j)) > dDT
    Next j
Next i
sbRebalancedReturn = vR
End Function

Download

Please read my Disclaimer.

Asset Allocation for a Portfolio on Sulprobil

PF_Allocate (VBA)

Abstract

Appendix – PF_Allocate Code

Download

sbRebalancedReturn (VBA)

Abstract

Appendix – sbRebalancedReturn Code

Download