VBA code for combinations given a sum.

Prit50 · Jan 29, 2014

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 · Jan 29, 2014

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 · Jan 29, 2014

There are about 54000 combinations:

[Table="width:, class:grid"][tr][td] [/td][td]

A

[/td][td]

B

[/td][td]

C

[/td][td]

D

[/td][td]

E

[/td][td]

F

[/td][/tr]
[tr][td]

1

[/td][td]

num1

[/td][td]

num2

[/td][td]

num3

[/td][td]

num4

[/td][td]

num5

[/td][td]

num6

[/td][/tr]

[tr][td]

2

[/td][td]

22

[/td][td]

21

[/td][td]

20

[/td][td]

18

[/td][td]

17

[/td][td]

16

[/td][/tr]

[tr][td]

3

[/td][td]

22

[/td][td]

21

[/td][td]

20

[/td][td]

19

[/td][td]

17

[/td][td]

15

[/td][/tr]

[tr][td]

4

[/td][td]

22

[/td][td]

21

[/td][td]

20

[/td][td]

19

[/td][td]

18

[/td][td]

14

[/td][/tr]

[tr][td]

5

[/td][td]

23

[/td][td]

21

[/td][td]

19

[/td][td]

18

[/td][td]

17

[/td][td]

16

[/td][/tr]

[tr][td]

6

[/td][td]

23

[/td][td]

21

[/td][td]

20

[/td][td]

18

[/td][td]

17

[/td][td]

15

[/td][/tr]

[tr][td]

7

[/td][td]

23

[/td][td]

21

[/td][td]

20

[/td][td]

19

[/td][td]

16

[/td][td]

15

[/td][/tr]

[tr][td]

8

[/td][td]

23

[/td][td]

21

[/td][td]

20

[/td][td]

19

[/td][td]

17

[/td][td]

14

[/td][/tr]

[tr][td]

9

[/td][td]

23

[/td][td]

21

[/td][td]

20

[/td][td]

19

[/td][td]

18

[/td][td]

13

[/td][/tr]

[tr][td]

10

[/td][td]

23

[/td][td]

22

[/td][td]

19

[/td][td]

18

[/td][td]

17

[/td][td]

15

[/td][/tr]

[tr][td]

11

[/td][td]

23

[/td][td]

22

[/td][td]

20

[/td][td]

18

[/td][td]

16

[/td][td]

15

[/td][/tr]

[tr][td]

12

[/td][td]

23

[/td][td]

22

[/td][td]

20

[/td][td]

18

[/td][td]

17

[/td][td]

14

[/td][/tr]

[tr][td]

13

[/td][td]

23

[/td][td]

22

[/td][td]

20

[/td][td]

19

[/td][td]

16

[/td][td]

14

[/td][/tr]

[tr][td]

14

[/td][td]

23

[/td][td]

22

[/td][td]

20

[/td][td]

19

[/td][td]

17

[/td][td]

13

[/td][/tr]
[/table]

Code:

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 · Jan 29, 2014

shg said:
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 · Jan 29, 2014

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 · Jan 29, 2014

About 64K combinations:

Code:

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

[Table="width:, class:grid"][tr][td] [/td][td]

A

[/td][td]

B

[/td][td]

C

[/td][td]

D

[/td][td]

E

[/td][td]

F

[/td][/tr]
[tr][td]

1

[/td][td]

num1

[/td][td]

num2

[/td][td]

num3

[/td][td]

num4

[/td][td]

num5

[/td][td]

num6

[/td][/tr]

[tr][td]

2

[/td][td]

39

[/td][td]

38

[/td][td]

37

[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]

3

[/td][td]

40

[/td][td]

38

[/td][td]

36

[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]

4

[/td][td]

40

[/td][td]

39

[/td][td]

35

[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]

5

[/td][td]

30

[/td][td]

29

[/td][td]

28

[/td][td]

27

[/td][td][/td][td][/td][/tr]

[tr][td]

6

[/td][td]

31

[/td][td]

29

[/td][td]

28

[/td][td]

26

[/td][td][/td][td][/td][/tr]

[tr][td]

7

[/td][td]

31

[/td][td]

30

[/td][td]

27

[/td][td]

26

[/td][td][/td][td][/td][/tr]

[tr][td]

8

[/td][td]

31

[/td][td]

30

[/td][td]

28

[/td][td]

25

[/td][td][/td][td][/td][/tr]

[tr][td]

9

[/td][td]

31

[/td][td]

30

[/td][td]

29

[/td][td]

24

[/td][td][/td][td][/td][/tr]

[tr][td]

10

[/td][td]

32

[/td][td]

29

[/td][td]

27

[/td][td]

26

[/td][td][/td][td][/td][/tr]

[tr][td]

11

[/td][td]

32

[/td][td]

29

[/td][td]

28

[/td][td]

25

[/td][td][/td][td][/td][/tr]

[tr][td]

12

[/td][td]

32

[/td][td]

30

[/td][td]

27

[/td][td]

25

[/td][td][/td][td][/td][/tr]

[tr][td]

13

[/td][td]

32

[/td][td]

30

[/td][td]

28

[/td][td]

24

[/td][td][/td][td][/td][/tr]

[tr][td]

14

[/td][td]

32

[/td][td]

30

[/td][td]

29

[/td][td]

23

[/td][td][/td][td][/td][/tr]
[/table]

btomjack · Jan 29, 2014

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 · Jan 29, 2014

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 · Jan 30, 2014

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

shg · Jan 30, 2014

You're welcome.

VBA code for combinations given a sum.

Prit50

New Member

Excel Facts

btomjack

Board Regular

shg

MrExcel MVP

btomjack

Board Regular

shg

MrExcel MVP

shg

MrExcel MVP

btomjack

Board Regular

shg

MrExcel MVP

Prit50

New Member

shg

MrExcel MVP

Similar threads

Forum statistics

Share this page

VBA code for combinations given a sum.

New Member

Excel Facts

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

MrExcel MVP

Board Regular

MrExcel MVP

New Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock