VBA: Look at column A, Paste all combination pairs into B & C

[scola]

Hi all ,

I've had a look on the forum, but cant quite find what I'm looking for. So hopefully you can help!

Here is an example:
[TABLE="width: 120"]
<colgroup><col span="3"></colgroup><tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]Org1[/TD]
[TD]Org1[/TD]
[TD]Org2[/TD]
[/TR]
[TR]
[TD]Org2[/TD]
[TD]Org1[/TD]
[TD]Org3[/TD]
[/TR]
[TR]
[TD]Org3[/TD]
[TD]Org1[/TD]
[TD]Org4[/TD]
[/TR]
[TR]
[TD]Org4[/TD]
[TD]Org1[/TD]
[TD]Org5[/TD]
[/TR]
[TR]
[TD]Org5[/TD]
[TD]Org2[/TD]
[TD]Org1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org2[/TD]
[TD]Org3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org2[/TD]
[TD]Org4[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org2[/TD]
[TD]Org5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org3[/TD]
[TD]Org1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org3[/TD]
[TD]Org2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org3[/TD]
[TD]Org4[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org3[/TD]
[TD]Org5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org4[/TD]
[TD]Org1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org4[/TD]
[TD]Org2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org4[/TD]
[TD]Org3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org4[/TD]
[TD]Org5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org5[/TD]
[TD]Org1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org5[/TD]
[TD]Org2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org5[/TD]
[TD]Org3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Org5[/TD]
[TD]Org4[/TD]
[/TR]
</tbody>[/TABLE]

Column A will hold the data sets (will be a variable list).
Column B & C should output all 'bi-directional' pairs that could be created by column A.

Notice that they aren't paired with themselves though - thats the bit I can't find an answer to!

Can someone help me with the VBA for this please

Thanks in advance!
Harry

 

[JackDanIce]

Hi, can you confirm for a list of 5, how many pairs you expect returned? Or use a shorter number (e.g. 3) and list all the expected outcomes

 

[scola]

Hi JackDanIce,

The above list is the full output.

So for a list of X, I would expect X(X-1) rows

Thanks

 

[JackDanIce]

Adapted from this link: Create list of all pair combinations

Try:

Sub Permutations()

    Dim rRng    As Range
    Dim p       As Long
    Dim LR      As Long
    Dim lRow    As Long
    Dim vElements   As Variant
    Dim vResult   As Variant
     
    LR = Cells(Rows.Count, 1).End(xlUp).row
    p = 2
     
    vElements = Application.Index(Application.Transpose(Cells(1, 1).Resize(LR)), 1, 0)
    ReDim vResult(1 To p)
    
    Application.ScreenUpdating = False
    
    PermutationsNP vElements, CInt(p), vResult, lRow, 1
    
    Application.ScreenUpdating = True
    
    Erase vResult
    
End Sub
 
Sub PermutationsNP(ByRef vElements As Variant, ByRef p As Long, ByRef vResult As Variant, ByRef lRow As Long, ByRef iIndex As Long)

    Dim i As Long
    Dim j As Long
    Dim 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
                Cells(lRow, 2).Resize(, p) = vResult
            Else
                Call PermutationsNP(vElements, p, vResult, lRow, iIndex + 1)
            End If
        End If
    Next i
    
End Sub

 

[scola]

ray:ray:ray:ray: JackDanIce

Thank you so much!!!

 

[JackDanIce]

You're welcome