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:

A	B	C
Org1	Org1	Org2
Org2	Org1	Org3
Org3	Org1	Org4
Org4	Org1	Org5
Org5	Org2	Org1
	Org2	Org3
	Org2	Org4
	Org2	Org5
	Org3	Org1
	Org3	Org2
	Org3	Org4
	Org3	Org5
	Org4	Org1
	Org4	Org2
	Org4	Org3
	Org4	Org5
	Org5	Org1
	Org5	Org2
	Org5	Org3
	Org5	Org4

<colgroup><col span="3"></colgroup><tbody>
</tbody>

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