Permutations of sets of values

[eilertsj]

Hello,

I'm a new VBA user and really need some help. I'm trying to perform pairwise permutations of an undetermined number of values entered along a single row. The permutations should be exported into columns A and B in another tab. Then I want to repeat this process for the next and all subsequent rows containing values, and I want these permutations to be subsequently entered in the same columns as the previous permutations i.e., A and B in the other tab.

Tab 1 looks like (Cell A1 is row 1, column A)

[TABLE="width: 256"]
<tbody>[TR]
[TD="class: xl66, width: 64"]A1[/TD]
[TD="class: xl66, width: 64"]A2[/TD]
[TD="class: xl66, width: 64"]A3[/TD]
[TD="class: xl66, width: 64"]A4[/TD]
[/TR]
[TR]
[TD="class: xl67"]B1[/TD]
[TD="class: xl67"]B2[/TD]
[TD="class: xl67"]B3[/TD]
[TD="class: xl67"]B4[/TD]
[/TR]
[TR]
[TD="class: xl65"]C1[/TD]
[TD="class: xl65"]C2[/TD]
[TD="class: xl65"]C3[/TD]
[TD="class: xl65"]C4[/TD]
[/TR]
</tbody>[/TABLE]

Tab 2 Should look like (Entries in column A, B)

[TABLE="width: 389"]
<tbody>[TR]
[TD]A1[/TD]
[TD]A2[/TD]
[TD][/TD]
[TD]Permutation Set 1 (From Row 1)[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]A3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]A4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD]A1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD]A3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD]A4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A3[/TD]
[TD]A1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A3[/TD]
[TD]A2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A3[/TD]
[TD]A4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A4[/TD]
[TD]A1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A4[/TD]
[TD]A2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A4[/TD]
[TD]A3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B1[/TD]
[TD]B2[/TD]
[TD][/TD]
[TD]Permutation Set 2 (From Row 2)[/TD]
[/TR]
[TR]
[TD]B1[/TD]
[TD]B3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B1[/TD]
[TD]B4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B2[/TD]
[TD]B1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B2[/TD]
[TD]B3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B2[/TD]
[TD]B4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B3[/TD]
[TD]B1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B3[/TD]
[TD]B2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B3[/TD]
[TD]B4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B4[/TD]
[TD]B1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B4[/TD]
[TD]B2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B4[/TD]
[TD]B3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C1[/TD]
[TD]C2[/TD]
[TD][/TD]
[TD]Permutation Set 3 (From Row 3)[/TD]
[/TR]
[TR]
[TD]C1[/TD]
[TD]C3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C1[/TD]
[TD]C4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C2[/TD]
[TD]C1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C2[/TD]
[TD]C3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C2[/TD]
[TD]C4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C3[/TD]
[TD]C1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C3[/TD]
[TD]C2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C3[/TD]
[TD]C4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C4[/TD]
[TD]C1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C4[/TD]
[TD]C2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]C4[/TD]
[TD]C3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I have been working with the code below, most of which was kindly provided by an expert from this forum. The code will perform pairwise permutations on the first row values starting in A1, Tab 1, and will output the permutation values to columns A and B in Tab 2, but I haven't been able to 1) cycle through subsequent rows in Tab 1, and 2) add the permutations to the previous permutations in the same two columns (A, B) in Tab 2.

Any help would be really appreciated!



Sub Permutations()




Dim rRng As Range, p
Dim vElements, lRow As Long, vresult As Variant




Set rRng = Worksheets("Tab 1").Range("A1", Range("A1").End(xlToRight))
p = 2 ' Pairwise permutations

vElements = Application.Index((rRng), 1, 0)
ReDim vresult(1 To p)
Application.ScreenUpdating = False
Call PermutationsNP(vElements, CInt(p), vresult, lRow, 1)
Application.ScreenUpdating = True
End Sub

Sub PermutationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iIndex As Integer)
Dim i As Long, j As Long, bSkip As Boolean

For i = 1 To UBound(vElements)
bSkip = False
For j = 1 To iIndex - 1
If vresult(j) = vElements(i) Then
bSkip = True
Exit For
End If
Next j
If Not bSkip Then
vresult(iIndex) = vElements(i)
If iIndex = p Then
lRow = lRow + 1
Worksheets("Tab 2").Range("A" & lRow).Resize(, p) = vresult 'Send permutations to Tab 2, column A, B
Else
Call PermutationsNP(vElements, p, vresult, lRow, iIndex + 1)
End If
End If
Next i




End Sub

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG20Aug13
[COLOR="Navy"]Sub[/COLOR] Permutations()
[COLOR="Navy"]Dim[/COLOR] rRng [COLOR="Navy"]As[/COLOR] Range, p
 [COLOR="Navy"]Dim[/COLOR] vElements, lRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] vresult [COLOR="Navy"]As[/COLOR] Variant, n
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray()
  
[COLOR="Navy"]Set[/COLOR] rRng = Worksheets("Tab 1").Range("A1").CurrentRegion
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] rRng
    c = c + 1
    ReDim Preserve Ray(c)
    Ray(c) = Dn
[COLOR="Navy"]Next[/COLOR] Dn
p = 2 '[COLOR="Green"][B] Pairwise permutations[/B][/COLOR]

 vElements = Ray
 ReDim vresult(1 To p)
 Application.ScreenUpdating = False
 Call PermutationsNP(vElements, CInt(p), vresult, lRow, 1)
 Application.ScreenUpdating = True
 
 [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

 [COLOR="Navy"]Sub[/COLOR] PermutationsNP(vElements [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] vresult [COLOR="Navy"]As[/COLOR] Variant, lRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] iIndex [COLOR="Navy"]As[/COLOR] Integer)
 [COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] j [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] bSkip [COLOR="Navy"]As[/COLOR] Boolean

 [COLOR="Navy"]For[/COLOR] i = 1 To UBound(vElements)
bSkip = False
[COLOR="Navy"]For[/COLOR] j = 1 To iIndex - 1
[COLOR="Navy"]If[/COLOR] vresult(j) = vElements(i) [COLOR="Navy"]Then[/COLOR]
bSkip = True
[COLOR="Navy"]Exit[/COLOR] For
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] j
[COLOR="Navy"]If[/COLOR] Not bSkip [COLOR="Navy"]Then[/COLOR]
vresult(iIndex) = vElements(i)
[COLOR="Navy"]If[/COLOR] iIndex = p [COLOR="Navy"]Then[/COLOR]
lRow = lRow + 1
Worksheets("Tab 2").Range("A" & lRow).Resize(, p) = vresult '[COLOR="Green"][B]Send permutations to Tab 2, column A, B[/B][/COLOR]
[COLOR="Navy"]Else[/COLOR]
Call PermutationsNP(vElements, p, vresult, lRow, iIndex + 1)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] i



[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[eilertsj]

Many thanks Mick That's almost got it! I believe your code is calculating all permutations of all values in all rows.

Sample output of the first 16 rows in Tab 2:

[TABLE="width: 128"]
<tbody>[TR]
[TD="width: 64"]A1[/TD]
[TD="width: 64"]A2[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]A3[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]A4[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]B1[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]B2[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]B3[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]B4[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]C1[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]C2[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]C3[/TD]
[/TR]
[TR]
[TD]A1[/TD]
[TD]C4[/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD]A1[/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD]A3[/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD]A4[/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD]B1[/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD]B2[/TD]
[/TR]
</tbody>[/TABLE]

I'd like to calculate a discrete set of permutations corresponding to each row (in Tab 1) individually. So in my example there would be a set of permutations consisting of pairs of only A values, and another set of permutations consisting of pairs of only B values, but no permutations containing pairs of A and B values.