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

## Example

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

``````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
Else
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)
Loop
End With
sbDistBudget = vR
End Function
``````