Out of 14 numbers make all unique combinations in with only 6 numbers in the row

motilulla · Jan 7, 2019

Hello,

I got 14 numbers in cells A5:A18 these numbers are changeable every time but (but always will be the 14 numbers)

I need VBA code, which can generate all possible unique combinations with 6 numbers in the columns D:I and sum of each row combination must be 6. Is it possible?

Example data

Book1

A

B

C

D

E

F

G

H

I

J

1

2

3

4

Numbers

n1

n2

n3

n4

n5

n6

SUM

5

0

1

0

4

6

0

1

4

0

6

7

1

0

1

2

6

8

1

0

1

0

4

1

6

9

1

0

1

4

0

1

6

10

0

1

4

1

0

6

11

4

0

1

2

1

6

12

0

4

0

2

6

13

2

0

4

2

0

6

14

0

2

6

15

2

0

4

0

2

0

6

16

2

0

4

0

2

6

17

1

0

4

2

0

6

18

0

2

0

2

6

19

0

2

0

6

20

0

1

2

1

6

21

0

1

0

4

0

6

22

0

1

0

2

6

23

0

1

4

0

6

24

0

1

2

0

2

6

25

0

1

2

0

6

26

0

1

0

4

0

1

6

27

0

1

0

4

1

0

6

28

0

1

0

2

1

6

29

0

1

4

0

1

6

30

0

1

4

0

1

0

6

31

0

1

2

0

2

1

6

32

0

1

2

1

0

6

33

0

4

0

2

0

6

34

0

4

0

2

0

6

35

0

2

0

2

0

6

36

1

0

2

1

6

37

1

2

0

1

6

38

1

2

1

0

6

39

1

0

4

0

6

40

1

0

2

6

41

1

0

2

0

2

6

42

1

0

2

0

6

43

1

4

0

6

44

1

2

0

2

0

6

45

1

0

4

0

1

6

46

1

0

4

0

1

0

6

47

1

0

2

1

6

48

1

0

2

0

2

1

6

49

1

0

2

1

0

6

50

1

4

0

1

0

6

51

1

2

0

2

1

0

6

Sheet1

Thank you all

Excel 2000
Regards,
Moti

StephenCrump · Jan 12, 2019

motilulla said:
This is just to clearly k = 6, I think this mean create permutations by 6 positions if I change k = 5, k = 4, k = 3 or k = 2 the code create permutations by the positions of k numbers. Why when I change K = 7, 8, 9 (I mean greeter than value 6) I get message "Run time error 7: out of memory"

I was being a bit lazy in allocating memory. If k = 9 then I'm trying to allocate PERMUT(14,9) x 9 spaces, which clearly is way too much.

In fact, given you have only four numbers, with frequencies 6,4,2, and 1, we only need to allocate room for 48,342 results, which is the coefficient of x^9 in:

9!(1 + x) (1+ x + x^2/2!+x^3/3!) (1 + x + x^2/2! + x^3/3! + x^4/4!)(1 + x + x^2/2! + x^3/3! + x^4/4! + x^5/5! + x^6/6!)

We can generate all 48,342 using this revised code:

Code:

Option Explicit
Dim k As Long, row As Long
Dim N As Variant, Permutations() As Variant
Sub Test()
    
    Dim Permutation() As Variant
    Dim rng As Range
    
    Set rng = Range("A5:B8")
    N = rng.Value
    k = 9
    row = 0
    ReDim Permutation(1 To k)
    ReDim Permutations(1 To GetCoefficients(rng, k)(k), 1 To k)
        
    Call GetPermutations(Permutation, 1)
    
    With Range("D5")
        .CurrentRegion.Offset(1).ClearContents
        With .Resize(row, k + 1)
            .Value = Permutations
           .Columns(k + 1).FormulaR1C1 = "=SUM(RC[-" & k & "]:RC[-1])"
            .Sort Key1:=.Columns(k + 1), Orientation:=xlTopToBottom, Order1:=xlAscending
        End With
    End With
        
End Sub
Sub GetPermutations(ByVal Permutation As Variant, col As Long)
    
    Dim i As Long, j As Long
    
    For i = 1 To UBound(N)
        If N(i, 2) > 0 Then
            Permutation(col) = N(i, 1)
            If col < k Then
                N(i, 2) = N(i, 2) - 1
                Call GetPermutations(Permutation, col + 1)
                N(i, 2) = N(i, 2) + 1
            Else
                row = row + 1
                For j = 1 To k
                    Permutations(row, j) = Permutation(j)
                Next j
            End If
        End If
    Next i
    
End Sub
Function GetCoefficients(rng As Range, N As Long) As Double()

    Dim i As Long, j As Long, k As Long, counter As Long
    Dim temp1() As Double, temp2() As Double, Result() As Double
    ReDim temp1(1 To rng.Rows.Count, 0 To Application.Sum(rng.Columns(2)))
    ReDim Result(0 To Application.Sum(rng.Columns(2)))
    
    For i = 1 To UBound(temp1)
        temp1(i, 0) = 1
        temp1(i, 1) = 1
        For j = 2 To rng(i, 2).Value
            temp1(i, j) = temp1(i, j - 1) / j
        Next j
    Next i
    
    For j = 0 To rng(1, 2).Value
        Result(j) = temp1(1, j) * Application.Fact(N)
    Next j

    counter = rng(1, 2).Value
    For i = 2 To UBound(temp1)
        ReDim temp2(0 To Application.Sum(rng.Columns(2)))
        For j = 0 To counter
            For k = 0 To rng(i, 2).Value
                temp2(j + k) = temp2(j + k) + Result(j) * temp1(i, k)
            Next k
        Next j
        Result = temp2
        counter = counter + rng(i, 2).Value
    Next i
    
    GetCoefficients = Result

End Function

StephenCrump · Jan 12, 2019

.. where this is the layout:

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

4

Number

Freq

n1

n2

n3

n4

n5

n6

n7

n8

n9

SUM

5

0

6

0

1

3

6

1

4

0

1

0

1

3

7

2

3

0

1

0

1

3

8

4

1

0

1

0

3

9

0

1

0

1

3

10

0

1

0

1

0

1

3

11

0

1

0

1

0

3

12

etc ..

Sheet1

StephenCrump · Jan 12, 2019

Should have said:

In fact, given you have only four numbers, with frequencies 6,4,3, and 1, we only need to allocate room for 48,342 results, which is the coefficient of x^9 in:

9!(1 + x) (1+ x + x^2/2!+x^3/3!) (1 + x + x^2/2! + x^3/3! + x^4/4!)(1 + x + x^2/2! + x^3/3! + x^4/4! + x^5/5! + x^6/6!)

motilulla · Jan 13, 2019

StephenCrump, thank you for sending me the revised code. As I am out for vacation till the 18th of January, this is why I don't have access to my desktop computer, thus i will reply as soon as i get back home.

Have a great weekend, Good Luck.

Kind Regards,
Moti

motilulla · Jan 18, 2019

StephenCrump said:
.. where this is the layout:

A B C D E F G H I J K L M
4 Number Freq n1 n2 n3 n4 n5 n6 n7 n8 n9 SUM
5 0 6 0 0 0 0 0 0 1 1 1 3
6 1 4 0 0 0 0 0 1 0 1 1 3
7 2 3 0 0 0 0 0 1 1 0 1 3
8 4 1 0 0 0 0 0 1 1 1 0 3
9 0 0 0 0 1 0 0 1 1 3
10 0 0 0 0 1 0 1 0 1 3
11 0 0 0 0 1 0 1 1 0 3
12 etc ..

<COLGROUP><COL style="BACKGROUND-COLOR: #dae7f5 "><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL><COL></COLGROUP><THEAD>
</THEAD><TBODY>
</TBODY>

StephenCrump, yes I like this getting layout as you shown and sum are sorted in ascending order that is very perfect!

motilulla · Jan 18, 2019

StephenCrump said:
Should have said:

In fact, given you have only four numbers, with frequencies 6,4,3, and 1, we only need to allocate room for 48,342 results, which is the coefficient of x^9 in:

9!(1 + x) (1+ x + x^2/2!+x^3/3!) (1 + x + x^2/2! + x^3/3! + x^4/4!)(1 + x + x^2/2! + x^3/3! + x^4/4! + x^5/5! + x^6/6!)

StephenCrump, I am too weak in maths formula and to solve such a complicate equations uff very difficult

motilulla · Jan 18, 2019

StephenCrump said:

I was being a bit lazy in allocating memory. If k = 9 then I'm trying to allocate PERMUT(14,9) x 9 spaces, which clearly is way too much.

In fact, given you have only four numbers, with frequencies 6,4,2, and 1, we only need to allocate room for 48,342 results, which is the coefficient of x^9 in:

9!(1 + x) (1+ x + x^2/2!+x^3/3!) (1 + x + x^2/2! + x^3/3! + x^4/4!)(1 + x + x^2/2! + x^3/3! + x^4/4! + x^5/5! + x^6/6!)

We can generate all 48,342 using this revised code:

Code:

Option Explicit
Dim k As Long, row As Long
Dim N As Variant, Permutations() As Variant
Sub Test()
    
    Dim Permutation() As Variant
    Dim rng As Range
    
    Set rng = Range("A5:B8")
    N = rng.Value
    k = 9
    row = 0
    ReDim Permutation(1 To k)
    ReDim Permutations(1 To GetCoefficients(rng, k)(k), 1 To k)
        
    Call GetPermutations(Permutation, 1)
    
    With Range("D5")
        .CurrentRegion.Offset(1).ClearContents
        With .Resize(row, k + 1)
            .Value = Permutations
           .Columns(k + 1).FormulaR1C1 = "=SUM(RC[-" & k & "]:RC[-1])"
            .Sort Key1:=.Columns(k + 1), Orientation:=xlTopToBottom, Order1:=xlAscending
        End With
    End With
        
End Sub
Sub GetPermutations(ByVal Permutation As Variant, col As Long)
    
    Dim i As Long, j As Long
    
    For i = 1 To UBound(N)
        If N(i, 2) > 0 Then
            Permutation(col) = N(i, 1)
            If col < k Then
                N(i, 2) = N(i, 2) - 1
                Call GetPermutations(Permutation, col + 1)
                N(i, 2) = N(i, 2) + 1
            Else
                row = row + 1
                For j = 1 To k
                    Permutations(row, j) = Permutation(j)
                Next j
            End If
        End If
    Next i
    
End Sub
Function GetCoefficients(rng As Range, N As Long) As Double()

    Dim i As Long, j As Long, k As Long, counter As Long
    Dim temp1() As Double, temp2() As Double, Result() As Double
    ReDim temp1(1 To rng.Rows.Count, 0 To Application.Sum(rng.Columns(2)))
    ReDim Result(0 To Application.Sum(rng.Columns(2)))
    
    For i = 1 To UBound(temp1)
        temp1(i, 0) = 1
        temp1(i, 1) = 1
        For j = 2 To rng(i, 2).Value
            temp1(i, j) = temp1(i, j - 1) / j
        Next j
    Next i
    
    For j = 0 To rng(1, 2).Value
        Result(j) = temp1(1, j) * Application.Fact(N)
    Next j

    counter = rng(1, 2).Value
    For i = 2 To UBound(temp1)
        ReDim temp2(0 To Application.Sum(rng.Columns(2)))
        For j = 0 To counter
            For k = 0 To rng(i, 2).Value
                temp2(j + k) = temp2(j + k) + Result(j) * temp1(i, k)
            Next k
        Next j
        Result = temp2
        counter = counter + rng(i, 2).Value
    Next i
    
    GetCoefficients = Result

End Function

StephenCrump, I am very happy it is working all right with any positions whatever I do select within the k.

Thank you so much for you're helping to me and solving my request as I required.

Have a nice weekend. Good Luck

Kind Regards
Moti

StephenCrump · Jan 21, 2019

motilulla said:
I am very happy it is working all right with any positions whatever I do select within the k.

Great. I am glad it's working for you.

StephenCrump said:
.. the coefficient of x^9 in:

9!(1 + x) (1+ x + x^2/2!+x^3/3!) (1 + x + x^2/2! + x^3/3! + x^4/4!)(1 + x + x^2/2! + x^3/3! + x^4/4! + x^5/5! + x^6/6!)

motilulla said:
I am too weak in maths formula and to solve such a complicate equations uff very difficult

And I am too lazy

. You've probably worked out by now - that's why I wrote the GetCoefficients function.

Out of 14 numbers make all unique combinations in with only 6 numbers in the row

motilulla

Well-known Member

StephenCrump

MrExcel MVP

Excel Facts

StephenCrump

MrExcel MVP

StephenCrump

MrExcel MVP

motilulla

Well-known Member

motilulla

Well-known Member

motilulla

Well-known Member

motilulla

Well-known Member

StephenCrump

MrExcel MVP

Similar threads

Forum statistics

Share this page

Out of 14 numbers make all unique combinations in with only 6 numbers in the row

Well-known Member

MrExcel MVP

Excel Facts

MrExcel MVP

MrExcel MVP

Well-known Member

Well-known Member

Well-known Member

Well-known 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