Distinct X,Y Data Combinations

[Juggler_IN]

I am posting this in lieu of an unanswered thread -- "VBA to List all Possible Pairs of X,Y Data in two Columns"

https://www.mrexcel.com/forum/excel-questions/1038311-vba-list-all-possible-pairs-x-y-data-two-columns.html

I have two columns of X,Y data. I need to rearrange them so that I get all possible distinct pairs. That is,

Keep the X’s in the same order. There are 5 possible Y’s for the first position. For each of these, there are 4 possible Y’s for the second. For each of these there are 3 possible Y’s for the third, and 2 for the fourth. And, so on.

Once we are done with the first value of X, we go on to the next, and so on.

For Example,
The master pair data is:

X,Y
1,6
2,7
3,8
4,9
5,0

The first few distinct possibilities (of the 120 possible) done manually are:

1,7
2,8
3,9
4,0
5,6

1,8
2,9
3,0
4,6
5,7

and so on.

I want a VBA solution to this and handle X,Y data with more than 5 pairs.

The number of ways the X and Y numbers could be paired involves pairing change only (Note that X’s do not become Y’s and Y’s do not become X’s. It is the pairings that change). This gives N=5, thus FACT(5) = 120 possible X,Y data with pair changes. If N the FACT(N) possible X,Y data pairs possible.

 

[MickG]

Try this :-
Data in Column "A & B", Results in Columns "C & D"

[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
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] rRng = Range("b1", Range("b1").End(xlDown))
p = 5
 
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Application.ScreenUpdating = False
Call PermutationsNP(vElements, CInt(p), vresult, lRow, 1, c)

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] [COLOR="Navy"]Integer,[/COLOR] c)
[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, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 
[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
            [COLOR="Navy"]For[/COLOR] n = 1 To UBound(vresult)
                c = c + 1
                Cells(c, "C") = n: Cells(c, "D") = vresult(n)
            [COLOR="Navy"]Next[/COLOR] n
            c = c + 1
        [COLOR="Navy"]Else[/COLOR]
            Call PermutationsNP(vElements, p, vresult, lRow, iIndex + 1, c)
        [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

 

[Juggler_IN]

Thanks Mick, a further help ... now if the Xs and Ys "CAN" interchange, with total N=10 elements for 5 pairs data (n1=5, n2=5), this gives =FACT(10)/(FACT(5)*FACT(5)) =252 possible X,Y data pairs.

How can the above code be modified?

Help appreciated.

 

[Juggler_IN]

Also Mick, the code is taking X as static 1,2,3,4,5 and not taking other values.

 

[MickG]

I don't understand the 252, although I can alter the code to run on the current "X,Y" data and then to swap All of data "X with Y", and also alter static "X" values.

Is that what you want ??
Please show example to clarify !!

 

[Juggler_IN]

Okay, let me explain and simplify ... in the above example values to X stay in X and values in Y stay in Y. For five pairs we get 120 distinct pairs.

Now, coming to, if the Xs and Ys "CAN" interchange, what I mean is, for example:

The master pair data is:

X,Y
1,6
2,7
3,8
4,9
5,0

The possible outcomes when X and Y values can "ALSO" interchange, are:

X,Y (Here 1 from X has moved to Y and 6 from Y has moved to X)
6,1
2,7
3,8
4,9
5,0

X,Y (Here 3, 4 from X has moved to Y and 8, 0 from Y has moved to X)
1,6
2,7
8,3
0,9
5,4

At any time X count = 5 and Y =5, as is the case in master data.

(Now, in real case it is a possibility that X=10 items and Y=5, (or any number of items in X and Y). Now, when the values interchange X count stays at 10 and Y at 5. That is to say, if X=N1, Y=N2 then when values get rearranged, X will always be N1 and Y will always be N2 in no. of elements.

Hope this helps.

Appreciate your help.

Thanks.

 

[MickG]

It sound interesting, but a bit too complicated and time consuming for me, so I'll wish you luck and hope someone else can take up the baton.
Regrds Mick

 

[Juggler_IN]

Sure Mick, a request, can you just help me with ... the code to run on the current "X,Y" data and then to swap All of data "X with Y", and also alter static "X" values?

 

[MickG]

Try this for results in column "C & D" and "E & F".

[COLOR=navy]Sub[/COLOR] Permutations()
[COLOR=navy]Dim[/COLOR] rRng [COLOR=navy]As[/COLOR] Range, p, r [COLOR=navy]As[/COLOR] Range, ac [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] col [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] vElements, lRow [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] vresult [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]For[/COLOR] ac = 0 To 1
[COLOR=navy]If[/COLOR] ac = 0 [COLOR=navy]Then[/COLOR]
    [COLOR=navy]Set[/COLOR] rRng = Range("b1", Range("b1").End(xlDown))
    [COLOR=navy]Set[/COLOR] r = rRng.Offset(, -1)
    col = 3
[COLOR=navy]Else[/COLOR]
    [COLOR=navy]Set[/COLOR] rRng = Range("A1", Range("A1").End(xlDown))
    [COLOR=navy]Set[/COLOR] r = rRng.Offset(, 1)
    col = 5
    c = 0
[COLOR=navy]End[/COLOR] If
p = 5
 
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Application.ScreenUpdating = False
Call PermutationsNP(vElements, CInt(p), vresult, lRow, 1, c, r, col)
Application.ScreenUpdating = True
[COLOR=navy]Next[/COLOR] ac
[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] [COLOR=navy]Integer,[/COLOR] c, r, col)
[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, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
 
[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
            [COLOR=navy]For[/COLOR] n = 1 To UBound(vresult)
                c = c + 1
                Cells(c, col) = r(n): Cells(c, col + 1) = vresult(n)
            [COLOR=navy]Next[/COLOR] n
            c = c + 1
        [COLOR=navy]Else[/COLOR]
            Call PermutationsNP(vElements, p, vresult, lRow, iIndex + 1, c, r, col)
        [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

 

[Juggler_IN]

Hi Mick,

When I am increasing the count from 5 to 7 or higher items per X and Y, the code is not working.
Basically, working till 6 items.