Try this:-

Code:

Sub MG20Aug13
Sub Permutations()
Dim rRng As Range, p
Dim vElements, lRow As Long, vresult As Variant, n
Dim Dn As Range, c As Long, Ray()
Set rRng = Worksheets("Tab 1").Range("A1").CurrentRegion
For Each Dn In rRng
c = c + 1
ReDim Preserve Ray(c)
Ray(c) = Dn
Next Dn
p = 2 '** Pairwise permutations**
vElements = Ray
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

Regards Mick

## Like this thread? Share it with others