VBA code for combinations given a sum.

[Prit50]

Hello Friends
Using Excel, am looking for a <ACRONYM title="visual basic for applications">VBA</ACRONYM> code that will list all combinations(Max 6 numbers) that will arrive at sum 114.
Conditions are:
Column A: Number 1 to 40
Sum: 114
Number cannot repeat in any each combination.

The output is to list all combinations(6 numbers only); each number displayed in a single cell that arrive at sum 114.

Many thanks for your assistance.​

 

[btomjack]

I think you may want to re-think your goal. Column A has 40 possible numbers (because you limited it to be 1 through 40). Because the combination can be up to 6 numbers, any number between 1 and 74 (except 40) is eligible to be chosen for column B (the second number in the series). Once you have the second number, you will have 40*73 combinations.

Let's take one of those combination in particular: 40+1. You would then have 71 more possible numbers. Suddenly we have 40*74*71. This is getting really big really fast.

There would be more than 7 million combinations for the 3rd number, and over 17 million for the 4th. Excel can't handle that many rows, and you would be hard-pressed to code something that could do it without repeating a given combination.

 

[shg]

There are about 54000 combinations:

	A​	B​	C​	D​	E​	F​
1​	num1​	num2​	num3​	num4​	num5​	num6​
2​	22​	21​	20​	18​	17​	16​
3​	22​	21​	20​	19​	17​	15​
4​	22​	21​	20​	19​	18​	14​
5​	23​	21​	19​	18​	17​	16​
6​	23​	21​	20​	18​	17​	15​
7​	23​	21​	20​	19​	16​	15​
8​	23​	21​	20​	19​	17​	14​
9​	23​	21​	20​	19​	18​	13​
10​	23​	22​	19​	18​	17​	15​
11​	23​	22​	20​	18​	16​	15​
12​	23​	22​	20​	18​	17​	14​
13​	23​	22​	20​	19​	16​	14​
14​	23​	22​	20​	19​	17​	13​

Sub Prit50()
    Const iSum      As Long = 114
    Const n         As Long = 40
    Const m         As Long = 6
    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

 

[btomjack]

There are about 54000 combinations:

I can't help but notice that all of your output has 6 numbers. What about those combinations of less than 6 numbers that add up to 114? He did specify that the maximum number of summands was 6, but did not specify that it HAD to be 6.

Excel usually only has about 50,000 to 60,000 rows. Are you sure this isn't limiting the number of combinations you output?

 

[shg]

I took that from this line:

The output is to list all combinations(6 numbers only)

It could be slightly modified to use fewer numbers.

Excel 2007 and later have about 1M rows.

 

[shg]

About 64K combinations:

Sub Prit50()
    Const iSum      As Long = 114
    Const n         As Long = 40
    Dim m           As Long
    Dim aiC()       As Long
    Dim rOut        As Range

    Set rOut = Range("A1")

    Application.ScreenUpdating = False
    For m = 1 To 6
        ReDim aiC(1 To m)
        aiC(1) = -1

        Do While bNextCombo(aiC, n)
            If WorksheetFunction.Sum(aiC) = iSum - m Then
                Set rOut = rOut.Offset(1)
                rOut.Resize(, m).Value = aiC
            End If
        Loop
    Next m

    rOut(2, 1).Value = 1
    rOut(2, 1).Copy
    Cells.SpecialCells(xlCellTypeConstants, xlNumbers).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlAdd
    Application.ScreenUpdating = True
    Beep
End Sub

	A​	B​	C​	D​	E​	F​
1​	num1​	num2​	num3​	num4​	num5​	num6​
2​	39​	38​	37​
3​	40​	38​	36​
4​	40​	39​	35​
5​	30​	29​	28​	27​
6​	31​	29​	28​	26​
7​	31​	30​	27​	26​
8​	31​	30​	28​	25​
9​	31​	30​	29​	24​
10​	32​	29​	27​	26​
11​	32​	29​	28​	25​
12​	32​	30​	27​	25​
13​	32​	30​	28​	24​
14​	32​	30​	29​	23​

 

[btomjack]

While my instincts tell me that it should be more than that, I'm going to concede defeat for now. My original math was wrong, and I'm having difficulty proving it mathematically.

Well played, shg...well played.

 

[shg]

Think of it this way:

All six-number combinations of the numbers 1 to 40 total between 21 (6+5+4+3+2+1) and 225 (40+...+35). There are COMBIN(40,6) = 3,838,380 ways to choose six numbers, so on average, the multiplicity of combinations totaling a given number within those limits is 3,838,380/(225-21+1) ~ 18,000 ways to arrive, and the distribution is roughly normal, so 54,000 for a number about in the middle doesn't sound out of bounds.

 

[Prit50]

Many thanks shg.. code works and exactly what am looking for. great job!

 

[shg]

You're welcome.