“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 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