# Numbers permutation.

#### serge

##### Well-known Member
I have a unusual request and maybe a formula can do the job ?

I have 10 numbers : 1,2,3,4,5,6,7,8,9,10. that need to be permuted in 3 groups 1,2,3, group 1 will host 3 numbers, Group 2 will host 4 numbers and Group 3 will host 3 numbers until each number will have been in each group at least one.

Thank you.

### Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
You'll only need four permutations, which are easy enough to set up manually, eg:

Excel 2010
ABC
1Group 1Group 2Group 3
2Take 1
3148
4259
53610
67
7Take 2
8714
9825
10936
1110
12Take 3
13471
14582
15693
1610
17Take 4
18107
19
20

<tbody>
</tbody>
Sheet1

Thank you Stephen for your respond, but I didn't explain myself right.

I meant for example group 1 will start like you did 1,2,3 then 1,2,4 then 1,2,5 etc... then 1,3,4 then 1,3,5 1,3,6 etc... with all numbers permuted with each other, that's what I'm looking for.

Maybe a macro would do the work ?

Regards.

If order matters, then there are 10! = 3.6 million arrangements.

If not, there are combin(10,3)*combin(7,4) = 4200.

Which do you need?

If order matters, then there are 10! = 3.6 million arrangements.

If not, there are combin(10,3)*combin(7,4) = 4200.

Which do you need?

Assuming 4,200 combinations:

Code:
``````Sub Test1()

Dim lNos As Long, lNoGroups As Long, lGroupSize() As Long, i As Long

lNos = 10
lNoGroups = 3
ReDim lGroupSize(1 To lNoGroups)
lGroupSize(1) = 3
lGroupSize(2) = 4
lGroupSize(3) = 3

With Sheets("Sheet1")
.Rows(1).ClearContents
.Range("A1:C1").Value = "Group1"
.Range("D1:G1").Value = "Group2"
.Range("H1:J1").Value = "Group3"
Call MakeGroups(lNos, lGroupSize, .Range("A2"))
End With

End Sub
Sub MakeGroups(lNos As Long, lGroupSize() As Long, rngOutput As Range)

Dim lNoGroups As Long, lCount1 As Long, lCount2 As Long, lProduct As Long
Dim lTemp() As Long, lCombinations() As Long, lNoCombinations() As Long
Dim lNumbers() As Long, lNosRemaining As Long, h As Long, i As Long, j As Long, k As Long
Dim lGroupSizeCumulative As Long, lProductCumulative As Long, lIndex1 As Long, lIndex2 As Long
Dim bUsed() As Boolean

lNoGroups = UBound(lGroupSize)
ReDim lNoCombinations(1 To lNoGroups)
lNosRemaining = lNos
lProduct = 1

For i = 1 To lNoGroups
lNoCombinations(i) = WorksheetFunction.Combin(lNos - lCount1, lGroupSize(i))
lCount1 = lCount1 + lGroupSize(i)
lProduct = lProduct * lNoCombinations(i)
Next i
ReDim lCombinations(1 To lProduct, 1 To lCount1)

'Group 1
lProductCumulative = lNoCombinations(1)
lTemp = GetCombinations(lNos, lGroupSize(1))
For i = 1 To lNoCombinations(1)
For j = 1 To lProduct / lNoCombinations(1)
For k = 1 To lGroupSize(1)
lCombinations(lProduct / lNoCombinations(1) * (i - 1) + j, k) = lTemp(i, k)
Next k
Next j
Next i

'Remaining Groups
For h = 2 To lNoGroups
lNosRemaining = lNosRemaining - lGroupSize(h - 1)
lGroupSizeCumulative = lGroupSizeCumulative + lGroupSize(h - 1)
lProductCumulative = lProductCumulative * lNoCombinations(h)
ReDim lNumbers(1 To lNosRemaining)
For i = 1 To lProduct / lProductCumulative
For j = 1 To lProductCumulative
lIndex1 = (i - 1) * lProductCumulative + j
If lNoCombinations(h) = 1 _
Or lIndex1 Mod lNoCombinations(h) * lProduct / lProductCumulative = 1 Then
ReDim bUsed(1 To lNos)
lCount2 = 0
For k = 1 To lGroupSizeCumulative
bUsed(lCombinations(lIndex1, k)) = True
Next k
For k = 1 To lNos
If Not bUsed(k) Then
lCount2 = lCount2 + 1
lNumbers(lCount2) = k
End If
Next k
lTemp = GetCombinations(lNosRemaining, lGroupSize(h))
End If
lIndex1 = lProductCumulative * (i - 1) + j
lIndex2 = 1 + Int((lIndex1 - 1) / (lProduct / lProductCumulative)) Mod lNoCombinations(h)
For k = 1 To lGroupSize(h)
lCombinations(lIndex1, lGroupSizeCumulative + k) _
= lNumbers(lTemp(lIndex2, k))
Next k
Next j
Next i
Next h

On Error Resume Next
Range("MyGroups").ClearContents
On Error GoTo 0
With rngOutput.Resize(lProduct, lCount1)
.Value = lCombinations
.Name = "MyGroups"
End With

End Sub
Function GetCombinations(lNumber As Long, lNoChosen As Long) As Long()

Dim lOutput() As Long, lCombinations As Long
Dim i As Long, j As Long, k As Long

lCombinations = WorksheetFunction.Combin(lNumber, lNoChosen)
ReDim lOutput(1 To lCombinations, 1 To lNoChosen)

For i = 1 To lNoChosen
lOutput(1, i) = i
Next i

For i = 2 To lCombinations
For j = 1 To lNoChosen
lOutput(i, j) = lOutput(i - 1, j)
Next j
For j = lNoChosen To 1 Step -1
lOutput(i, j) = lOutput(i, j) + 1
If lOutput(i, j) <= lNumber - (lNoChosen - j) Then Exit For
Next j
For k = j + 1 To lNoChosen
lOutput(i, k) = lOutput(i, k - 1) + 1
Next k
Next i

GetCombinations = lOutput

End Function``````

Thank you guys for your responses,

A special thank you to Stephen for this incredible macro, I really appreciate your help, I wasn't expecting that many combinations but it will work for what I need.

Regards,
Serge.

Replies
1
Views
433
Replies
1
Views
241
Replies
1
Views
241
Replies
4
Views
319
Replies
23
Views
2K

1,196,325
Messages
6,014,650
Members
441,834
Latest member
GHOSTOF309

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back