List all combinations which increase average

Suppose you have a row with 9 numbers. The average is always calculated as an integer (rounded down).

Can you list all possible combinations of minimal value increases to reach the next higher average, if you are only allowed to increase numbers up to the current average?


The sum of input row numbers (row 2) is 42. You need a sum of 45 to get to the next higher average of 5. Since you can only increase numbers up to the current average of 4, you can only change input cells E2 and I2. There are three possible combinations which are listed in rows 10:12. This problem has been stated in a German Excel forum.

Please read my Disclaimer.

Sub Combinations()
' V0.1 29-Jun-2020
Dim i As Long, j As Long
Dim lCount As Long, lSumTarget As Long, lAvg As Long
Dim dAvg As Double
Dim v As Variant, vMax As Variant, vMin As Variant
With Application.WorksheetFunction
j = 10
v = Range(Cells(2, 1), Cells(2, 1).End(xlToRight))
lCount = UBound(v, 2) - LBound(v, 2) + 1
dAvg = .Average(v)
lAvg = .RoundDown(dAvg, 0)
lSumTarget = .RoundDown(dAvg + 1#, 0) * lCount
vMax = v
For i = 1 To lCount
If vMax(1, i) < lAvg Then vMax(1, i) = lAvg
Next i
vMin = v
Select Case .Sum(vMax)
Case Is < lSumTarget
[A10] = "There is no solution."
Case Is = lSumTarget
Range(Cells(j, 1), Cells(j, lCount)).FormulaArray = vMax
Case Else
i = 1
Do While i <= lCount
Do While v(1, i) = vMax(1, i)
i = i + 1
If i > lCount Then Exit Sub
v(1, i) = v(1, i) + 1
Do While i > 1
i = i - 1
v(1, i) = vMin(1, i)
If .Sum(v) = lSumTarget Then
Range(Cells(j, 1), Cells(j, lCount)).FormulaArray = v
j = j + 1
End If
End Select
End With
End Sub