Option Explicit

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): https://www.sulprobil.de/sbdistbudget_en/
'Source (DE): https://www.berndplumhoff.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
With Application
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
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