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.


[TABLE="width: 0"]
<tbody>[TR]
[TD]5910685[/TD]
[TD] 1[/TD]
[TD]1[/TD]
[TD] 1[/TD]
[/TR]
[TR]
[TD]5901763[/TD]
[TD] 2[/TD]
[TD]2 [/TD]
[TD] 2[/TD]
[/TR]
[TR]
[TD]5903425[/TD]
[TD] 3[/TD]
[TD]3[/TD]
[TD] 3[/TD]
[/TR]
[TR]
[TD]5907277[/TD]
[TD] 4[/TD]
[TD]4[/TD]
[TD] 4[/TD]
[/TR]
[TR]
[TD]5901322[/TD]
[TD] 5 [/TD]
[TD]5[/TD]
[TD] 5[/TD]
[/TR]
[TR]
[TD]5902455[/TD]
[TD] 6[/TD]
[TD]6[/TD]
[TD] 6[/TD]
[/TR]
</tbody>[/TABLE]

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

[TABLE="width: 0"]
<tbody>[TR]
[TD]1 [/TD]
[TD] 1[/TD]
[TD] 1[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD] 2[/TD]
[TD] 2[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD] 3[/TD]
[TD] 3[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD] 4[/TD]
[TD] 4[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD] 5[/TD]
[TD] 5 [/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD] 6[/TD]
[TD] 6[/TD]
[TD]6[/TD]
[/TR]
</tbody>[/TABLE]

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

[TABLE="width: 0"]
<tbody>[TR]
[TD]1[/TD]
[TD]1[/TD]
[TD] 1[/TD]
[TD] 1[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD] 2[/TD]
[TD] 1[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]2[/TD]
[TD] 3[/TD]
[TD] 3[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]1[/TD]
[TD] 1[/TD]
[TD] 4[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]3[/TD]
[TD] 5[/TD]
[TD] 1[/TD]
[/TR]
[TR]
[TD]2 [/TD]
[TD]6[/TD]
[TD] 4[/TD]
[TD] 6[/TD]
[/TR]
</tbody>[/TABLE]

Good output in Sheet 2 would look like this:
[TABLE="width: 0"]
<tbody>[TR]
[TD]1[/TD]
[TD] 2[/TD]
[TD] 3[/TD]
[TD] 4[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD] 4[/TD]
[TD] 5[/TD]
[TD] 6[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD] 2[/TD]
[TD] 5[/TD]
[TD] 6[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD] 1[/TD]
[TD] 2[/TD]
[TD] 5[/TD]
[/TR]
[TR]
[TD]5 [/TD]
[TD] 3[/TD]
[TD] 5[/TD]
[TD] 1[/TD]
[/TR]
[TR]
[TD]2 [/TD]
[TD] 5[/TD]
[TD] 4[/TD]
[TD] 6[/TD]
[/TR]
</tbody>[/TABLE]

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):


[TABLE="width: 0"]
<tbody>[TR]
[TD]1[/TD]
[TD] 2[/TD]
[TD] 3[/TD]
[TD] 4[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD] 2[/TD]
[TD] 4[/TD]
[TD] 3[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD] 3[/TD]
[TD] 2[/TD]
[TD] 4[/TD]
[/TR]
[TR]
[TD]1 [/TD]
[TD] 3[/TD]
[TD] 4[/TD]
[TD] 2[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD] 4[/TD]
[TD] 3[/TD]
[TD] 2[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD] 4[/TD]
[TD] 2[/TD]
[TD] 3[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD] 1 [/TD]
[TD] 3[/TD]
[TD] 4[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD] 1[/TD]
[TD] 4 [/TD]
[TD] 3[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD] 3[/TD]
[TD] 1[/TD]
[TD] 2[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD] 3[/TD]
[TD] 1[/TD]
[TD] 4[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD] 4[/TD]
[TD] 1[/TD]
[TD] 3[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD] 4[/TD]
[TD] 3 [/TD]
[TD] 1[/TD]
[/TR]
</tbody>[/TABLE]


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

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Forum statistics

Threads
1,224,819
Messages
6,181,153
Members
453,021
Latest member
Justyna P

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