“Givers have to set limits because takers rarely do.” [Irma Kurtz]


Suppose your company is in the middle of its annual process to plan its revenues and expenses. You are head of a division with 6 departments (A to F). Your department heads requested 2000, 1900, 2000, 2000, 600 and 2000 € but you only got a budget of 9500 € from your company. Your departments' weighted contributions to your company’s revenues are 30%, 20%, 15%, 15%, 10% and 10%.

How do you distribute your budget? You surely would not give them more than they have asked for…


Appendix sbDistBudget Code

Please read my Disclaimer.

Function sbDistBudget(dBudget As Double, _
    vRequest As Variant, _
    vWeight As Variant) As Variant
'Distribute a budget fairly upon Ubound(vRequest)
'requestors according to their weight vWeight(i)
'but do not give them more than they requested.
'Iterative solution.
'Source (EN): http://www.sulprobil.com/sbdistbudget_en/
'Source (DE): http://www.bplumhoff.de/sbdistbudget_de/
'(C) (P) by Bernd Plumhoff 03-Dec-2012 PB V0.22
Dim dSumRequest As Double
Dim dSumWeight As Double
Dim dSumDist As Double
Dim dBudgetRest As Double
Dim dMinRest As Double
Dim i As Long, lc As Long, lgtNull As Long
lc = vRequest.Count
If lc <> vWeight.Count Then
    sbDistBudget = CVErr(xlErrValue)
    Exit Function
End If
ReDim dWeight(1 To lc) As Double
ReDim vR(1 To lc) As Variant 'Result vector
ReDim vT(1 To lc) As Variant 'Temp vector
With Application.WorksheetFunction
dSumRequest = .Sum(vRequest)
If dSumRequest <= dBudget Then
    'Easy case: budget >= requests
    For i = 1 To lc
        vR(i) = vRequest(i)
    Next i
    sbDistBudget = vR
    Exit Function
End If
'Initialize budget distribution
dBudgetRest = dBudget
For i = 1 To lc
    dWeight(i) = vWeight(i)
Next i
'Distribute budget
Do While dBudget > dSumDist
    dSumWeight = .Sum(dWeight)
    If dSumWeight > 0# Then
        For i = 1 To lc
            vT(i) = dWeight(i) * dBudgetRest / dSumWeight
            If vT(i) + vR(i) >= vRequest(i) Then
                vT(i) = vRequest(i) - vR(i)
                dWeight(i) = 0#
            End If
            vR(i) = vR(i) + vT(i)
        Next i
        lgtNull = 0
        dMinRest = dBudgetRest
        For i = 1 To lc
            vT(i) = .Max(vRequest(i) - vR(i), 0#)
            If vT(i) > 0# Then
                lgtNull = lgtNull + 1
                If dMinRest > vT(i) Then
                    dMinRest = vT(i)
                End If
            End If
        Next i
        If lgtNull = 0 Then Exit Do
        If dMinRest > dBudgetRest / lgtNull Then
            dMinRest = dBudgetRest / lgtNull
        End If
        For i = 1 To lc
            If vT(i) > 0# Then
                vR(i) = vR(i) + dMinRest
                vT(i) = dMinRest
            End If
        Next i
    End If
    dBudgetRest = dBudgetRest - .Sum(vT)
    dSumDist = .Sum(vR)
End With
sbDistBudget = vR
End Function