https://www.mrexcel.com/board/threads/vba-code-for-combinations-given-a-sum.753905/

[michaelsmith559]

I was reading searching for a solution to a problem I had and found the post linked above. I really liked the answer given in post #6 and would like help tweaking the code. When I ran the code the results started in row 2 and I would like the results starting in row 1. Also, at the end of the results in column A, there is a 1 below the results, can this be removed as well? Secondly, the results are put in across columns starting with the largest value in the first column and the smallest digit in the last column. Can this be reversed so that it puts the results starting with the lowest value to the highest value? And lastly, I think in post #9, Shg was calculated the results by giving the total number of combinations divided by the largest sum minus smallest sum + 1. Is there a way to calculate how many combinations there are for a given sum? Thanks for the help.
Mike

 

[michaelsmith559]

Here is the code:

Sub Combination_Sums()
    Const iSum      As Long = 228
    Const n         As Long = 70
    Const m         As Long = 5
    Dim aiC()       As Long
    Dim rOut        As Range

    Set rOut = Range("A1").Resize(, m)

    ReDim aiC(1 To m)
    aiC(1) = -1

    Application.ScreenUpdating = False
    Do While bNextCombo(aiC, n)
        If WorksheetFunction.Sum(aiC) = iSum - m Then
            Set rOut = rOut.Offset(1)
            rOut.Value = aiC
        End If
    Loop
    rOut(2, 1).Value = 1
    rOut(2, 1).Copy
    Range("A2").Resize(rOut.Row - 1, m).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
    Application.ScreenUpdating = True
    Beep
End Sub

Public Function bNextCombo(aiC() As Long, n As Long) As Boolean
    ' shg 2009-12
    '     2011-07 (modified to require aiC(0) < 0 to initialize)

    ' VBA only

    ' Sets aiC to the next combination of n choose m in lexical order
    ' Returns True unless the combination is the last, in which case
    ' it leaves aiC unmodified.

    ' If aiC(1) < 0, initializes aiC to the first combo:
    '                   {m-1,  m-2, ...,     1,   0}
    ' The last combo is {n-1,  n-2, ..., n-m+1, n-m}

    Dim m           As Long
    Dim i           As Long

    m = UBound(aiC)
    If n < m Then Exit Function

    If aiC(1) < 0 Then    ' set initial combo
        i = 1
        aiC(1) = m - 2

    Else

        ' find rightmost incrementable index
        For i = m To 2 Step -1
            If aiC(i) < aiC(i - 1) - 1 Then Exit For
        Next i
    End If

    If i <> 1 Or aiC(1) < n - 1 Then
        ' increment that index, and set 'righter' indices descending to 0
        aiC(i) = aiC(i) + 1
        For i = i + 1 To m
            aiC(i) = m - i
        Next i

        bNextCombo = True
    End If
End Function

Here is the output; I deleted several rows so that the end could be seen.

Book1
	A	B	C	D	E	F
1
2	48	47	46	44	43
3	48	47	46	45	42
4	49	47	45	44	43
5	49	47	46	44	42
6	49	47	46	45	41
7	70	69	68	19	2
8	70	69	68	20	1
9	1
Sheet1

Here is the output I am trying to get:

Book1
	A	B	C	D	E
1	43	44	46	47	48
2	42	45	46	47	48
3	43	44	45	47	49
4	42	44	46	47	49
5	41	45	46	47	49
6	2	19	68	69	70
7	1	20	68	69	70
Sheet1