List all Permutations/combinations except duplicates

tsatte

New Member
Joined
Oct 30, 2018
Messages
8
Please help, I need to generate rounds for security guards at multiple stations and I am looking to see if someone can help me using the code below to create a macro that would print only the unique permutations/combinations in sheet 2:

For instance in sheet 1 my input would be the guards ID number in A1 5910685 and B1 would equal 1 and C2 would equal 1 just like below.


5910685 11 1
5901763 22 2
5903425 33 3
5907277 44 4
5901322 5 5 5
5902455 66 6

<tbody>
</tbody>

You can use 1 instead of the id number 5910685 and 2 instead of 5901763 and so on so the input can be:

1 1 11
2 2 22
3 3 33
4 4 44
5 5 5 5
6 6 66

<tbody>
</tbody>

Here are some examples of Bad output that should not showup in Sheet 2 because there are duplicate numbers in each row:

11 1 1
12 2 1
22 3 3
41 1 4
53 5 1
2 6 4 6

<tbody>
</tbody>

Good output in Sheet 2 would look like this:
1 2 3 4
2 4 5 6
1 2 5 6
4 1 2 5
5 3 5 1
2 5 4 6

<tbody>
</tbody>

The code below will allow me to specify what row to end on (1,000,000) and how many columns separate the data (4) in sheet 2.


Sub Permute()
Dim ix(100, 1) As Long, rc As Long, m As Long, md As Variant, i As Long, r As Long, c As Long
Dim MyOut() As Variant, mor As Long, cbr As Long

' Set your max output rows here:
mor = 1000000
' Set columns between results here:
cbr = 4

rc = Cells(1, Columns.Count).End(xlToLeft).Column
m = 0
For i = 1 To rc
ix(i, 0) = Cells(Rows.Count, i).End(xlUp).Row
ix(i, 1) = 1
m = IIf(ix(i, 0) > m, ix(i, 0), m)
Next i
md = Range(Cells(1, 1), Cells(m, rc)).Value
ReDim MyOut(1 To mor, 1 To rc)

r = 0
c = 1
Incr:
r = r + 1
If r > mor Then
Sheets("Sheet2").Cells(1, c).Resize(mor, rc).Value = MyOut
r = 1
c = c + rc + cbr
ReDim MyOut(1 To mor, 1 To rc)
End If

For i = 1 To rc
MyOut(r, i) = md(ix(i, 1), i)
Next i

For i = rc To 1 Step -1
ix(i, 1) = ix(i, 1) + 1
If ix(i, 1) <= ix(i, 0) Then GoTo Incr:
ix(i, 1) = 1
Next i

Sheets("Sheet2").Cells(1, c).Resize(mor, rc).Value = MyOut

End Sub


The other thing on my wish list is to have only one of the following show up in my list because they are virtually all the same number (I didn’t include all of the combinations but just a few for 1,2,3,4):


1 2 3 4
1 2 4 3
1 3 2 4
1 3 4 2
1 4 3 2
1 4 2 3
2 1 3 4
2 1 4 3
2 3 1 2
2 3 1 4
2 4 1 3
2 4 3 1

<tbody>
</tbody>


I am ok if the last item can't be done, but it sure would be helpful!
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,398
Latest member
rjsteward

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top