Permutation/Combination/Pairs order unimportant.

[HL8]

Hi,
I'm trying to take a list of authors and create pairs from them. Th
order in which they appear in a pair doesn't matter and I don't wan
duplicates of these pairs (I need them to generate coauthorship data)
So, I have:

A
B
C
D

And want to generate:
AB
AC
AD
BC
BD
CD

This leaves out matches like "BA" since I already have "AB" and th
order is unimportant to me. I've used the code below to create the ful
list of matches, but the output *does* include both "BA" and "AB".

Sub Permutations_2()
Dim rRng As Range
Dim lRow As Long, j As Long, k As Long

Set rRng = Range("A1", Range("A1").End(xlDown)) ' The set of values

For j = 1 To rRng.Count
For k = 1 To rRng.Count
If j <> k Then
lRow = lRow + 1
Range("C" & lRow) = Range("a" & j)
Range("D" & lRow) = Range("a" & k)
End If
Next k
Next j
End Sub

Any ideas on how to eliminate the duplicates - either in the macro or i
an additional step?

Many thanks

 

[joeu2004]

Sub Permutations_2()
Dim rRng As Range
Dim lRow As Long, j As Long, k As Long
Set rRng = Range("A1", Range("A1").End(xlDown)) ' The set of values
For j = 1 To rRng.Count
For k = 1 To rRng.Count
If j <> k Then
lRow = lRow + 1
Range("C" & lRow) = Range("a" & j)
Range("D" & lRow) = Range("a" & k)
End If
Next k
Next j
End Sub

Any ideas on how to eliminate the duplicates -
either in the macro or in an additional step?

For j = 1 to rRng.Count-1
For k = j + 1 to rRng.Count
lRow = lRow + 1
Range("C" & lRow) = Range("a" & j)
Range("D" & lRow) = Range("a" & k)
Next
Next

More efficient:

Dim v As Variant
For j = 1 to rRng.Count-1
v = Range("a" & j)
For k = j + 1 to rRng.Count
lRow = lRow + 1
Range("C" & lRow) = v
Range("D" & lRow) = Range("a" & k)
Next
Next

 

[HL8]

This worked perfectly. Thanks for the help!

Sub Permutations_2()
Dim rRng As Range
Dim lRow As Long, j As Long, k As Long
Set rRng = Range("A1", Range("A1").End(xlDown)) ' The set of values
For j = 1 To rRng.Count
For k = 1 To rRng.Count
If j <> k Then
lRow = lRow + 1
Range("C" & lRow) = Range("a" & j)
Range("D" & lRow) = Range("a" & k)
End If
Next k
Next j
End Sub

Any ideas on how to eliminate the duplicates -
either in the macro or in an additional step?-

For j = 1 to rRng.Count-1
For k = j + 1 to rRng.Count
lRow = lRow + 1
Range("C" & lRow) = Range("a" & j)
Range("D" & lRow) = Range("a" & k)
Next
Next

More efficient:

Dim v As Variant
For j = 1 to rRng.Count-1
v = Range("a" & j)
For k = j + 1 to rRng.Count
lRow = lRow + 1
Range("C" & lRow) = v
Range("D" & lRow) = Range("a" & k)
Next
Nex