Permutations of sets of values

eilertsj

New Member
Joined
Aug 20, 2019
Messages
2
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)

A1A2A3A4
B1B2B3B4
C1C2C3C4

<tbody>
</tbody>

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

A1A2Permutation Set 1 (From Row 1)
A1A3
A1A4
A2A1
A2A3
A2A4
A3A1
A3A2
A3A4
A4A1
A4A2
A4A3
B1B2Permutation Set 2 (From Row 2)
B1B3
B1B4
B2B1
B2B3
B2B4
B3B1
B3B2
B3B4
B4B1
B4B2
B4B3
C1C2Permutation Set 3 (From Row 3)
C1C3
C1C4
C2C1
C2C3
C2C4
C3C1
C3C2
C3C4
C4C1
C4C2
C4C3

<tbody>
</tbody>

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
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Try this:-
Code:
[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
 
Upvote 0
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:

A1A2
A1A3
A1A4
A1B1
A1B2
A1B3
A1B4
A1C1
A1C2
A1C3
A1C4
A2A1
A2A3
A2A4
A2B1
A2B2

<tbody>
</tbody>

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.
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,312
Members
448,564
Latest member
ED38

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