Combine all possible combinations from single column without vba

[andrew_milonavic]

Hi Everyone,

I'd like to combine all possible combinations (text) from a single column into another.

I was able to find this formula

=IF(ROW()-ROW($F$1)+1>COUNTA(A:A)*COUNTA(B:B),"",INDEX(A:A,INT((ROW()-ROW($F$1))/COUNTA(B:B)+1))&INDEX(B:B,MOD(ROW()-ROW($F$1),COUNTA(B:B))+1))

which works perfectly for two columns of data but I wasn't able to make it work for just one column of data.

Hope you guys can help!

Thanks

Andrew

 

[wideboydixon]

Or, if you're prepared to have helper columns:

Book1
	A	B	C	D
1	Ant	1	2	Ant,Bear
2	Bear	1	3	Ant,Cat
3	Cat	1	4	Ant,Dog
4	Dog	1	5	Ant,Elephant
5	Elephant	1	6	Ant,Frog
6	Frog	1	7	Ant,Gorilla
7	Gorilla	2	3	Bear,Cat
8		2	4	Bear,Dog
9		2	5	Bear,Elephant
10		2	6	Bear,Frog
11		2	7	Bear,Gorilla
12		3	4	Cat,Dog
13		3	5	Cat,Elephant
14		3	6	Cat,Frog
15		3	7	Cat,Gorilla
16		4	5	Dog,Elephant
17		4	6	Dog,Frog
18		4	7	Dog,Gorilla
19		5	6	Elephant,Frog
20		5	7	Elephant,Gorilla
21		6	7	Frog,Gorilla
Sheet1

Cell Formulas
Range	Formula
B1	=IF(COUNTA(A:A)>1,1,"")
B2	=IF(ROW()>COUNTA(A:A)*(COUNTA(A:A)-1)/2,"",IF(C1=COUNTA(A:A),B1+1,B1))
C1	=IF(COUNTA(A:A)>1,2,"")
C2	=IF(ROW()>COUNTA(A:A)*(COUNTA(A:A)-1)/2,"",IF(C1=COUNTA(A:A),B2+1,C1+1))
D1	=IF(B1="","",INDEX(A:A,B1)&","&INDEX(A:A,C1))

Copy formulas in B2 and C2 down. Copy formula in D1 down.

WBD

 

[andrew_milonavic]

Thanks Wideboydixon,

Helper columns are fine, so that works perfect.

I'm not really familiar with vba's but maybe I'll start to play around.

Thanks for the help!

Andrew

 

[deebofitts]

Trying to think about doing that in a formula gives me a headache. Trivial task for VBA though:

Public Sub GetUniquePairs()

Dim lastRow As Long
Dim thisRow As Long
Dim i As Long
Dim j As Long

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
thisRow = 1
For i = 1 To lastRow - 1
    For j = i + 1 To lastRow
        Cells(thisRow, 2).Value = Cells(i, 1).Value & "," & Cells(j, 1).Value
        thisRow = thisRow + 1
    Next j
Next i

End Sub

WBD

wideboydixon how would I convert this code to read from 4 lists and get all possible combinations? Duplicates will not be an issue.

Size	Type	Rating	Length
2	RF	150	8
4		300	10
6			12
8
10
12
14

<colgroup><col width="64" span="5" style="width:48pt"> </colgroup><tbody>
</tbody>

Like if you have 4 rows like that, the 1st results would be 2RF1508 then 2RF15010 then 2RF15012 then 2RF3008....and so on?

Thanks.

 

[maw230]

Trying to think about doing that in a formula gives me a headache. Trivial task for VBA though:

Public Sub GetUniquePairs()

Dim lastRow As Long
Dim thisRow As Long
Dim i As Long
Dim j As Long

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
thisRow = 1
For i = 1 To lastRow - 1
    For j = i + 1 To lastRow
        Cells(thisRow, 2).Value = Cells(i, 1).Value & "," & Cells(j, 1).Value
        thisRow = thisRow + 1
    Next j
Next i

End Sub

WBD

For me this code is close, but not quite working. The reason seems to be with the loop iteration "counter". It works for the first value, but for the 2nd value it loops through n-1 times, so you are missing 1. This happens until the very end where the last value is only matched with one other. Now that I type this out I realize that this may be by design, because once you get to the last value it's already been matched against every other value. The difference in my case is that the order of the matches matters, so I need value 1 to be first in the concatenated result for each match and the same for value 274.

At this point I'm just typing out my situation, so that I'll understand it better! Going to take a stab at modifying the VBA, but in the meantime if anyone knows how to do it quickly feel free to let me know!

 

[maw230]

For me this code is close, but not quite working. The reason seems to be with the loop iteration "counter". It works for the first value, but for the 2nd value it loops through n-1 times, so you are missing 1. This happens until the very end where the last value is only matched with one other. Now that I type this out I realize that this may be by design, because once you get to the last value it's already been matched against every other value. The difference in my case is that the order of the matches matters, so I need value 1 to be first in the concatenated result for each match and the same for value 274.

At this point I'm just typing out my situation, so that I'll understand it better! Going to take a stab at modifying the VBA, but in the meantime if anyone knows how to do it quickly feel free to let me know!

Couldn't figure out how to edit this post, but I believe I got what I needed via this code:

Public Sub GetUniquePairs2()
Dim lastRow As Long
Dim thisRow As Long
Dim i As Long
Dim j As Long
'Dim inc As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
thisRow = 1
Debug.Print (lastRow - 1) * (lastRow - 1)
    For i = 1 To lastRow - 1
        For j = 1 To lastRow
            
            If Not Cells(j, 1).Value = Cells(i, 1).Value Then
                Cells(thisRow, 2).Value = Cells(i, 1).Value & "|" & Cells(j, 1).Value
                thisRow = thisRow + 1
            End If
        Next j
    Next i
End Sub

It meets the needs I described in my earlier post. Hope it helps someone else.

 

[Tanjamuse]

I know this is an old thread, but I'm hoping someone can help me with this:

How do I add a space after the comma and can you help me create a version where it's 3 instead of 2 values?

Ant	Ant, Bear
Bear	Ant, Bear, Cat
Cat	Ant, Bear, Dog
Dog	Ant, Cat
	Ant, Cat, Dog

<tbody>
</tbody>

 

[Sanjeev1976]

Try :

Public Sub GetUniquePairs()


Dim lastRow As Long
Dim thisRow As Long
Dim i As Long
Dim j As Long
Dim k As Long


lastRow = Cells(Rows.Count, 1).End(xlUp).Row
thisRow = 1
For i = 1 To lastRow - 1
For j = i + 1 To lastRow
For k = j + 1 To lastRow
Cells(thisRow, 2).Value = Cells(i, 1).Value & ", " & Cells(j, 1).Value & ", " & Cells(k, 1).Value
thisRow = thisRow + 1
Next k
Next j
Next i


End Sub

 

[Tanjamuse]

Thanks, is there a way to combine the two?

 

[Sanjeev1976]

Thanks, is there a way to combine the two?

Try :

Public Sub GetUniquePairs()


Dim lastRow As Long
Dim thisRow As Long
Dim i As Long
Dim j As Long
Dim k As Long


lastRow = Cells(Rows.Count, 1).End(xlUp).Row
thisRow = 1
For i = 1 To lastRow - 1
For j = i + 1 To lastRow
Cells(thisRow, 2).Value = Cells(i, 1).Value & ", " & Cells(j, 1).Value
thisRow = thisRow + 1
Next j
Next i

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow - 1
For j = i + 1 To lastRow
For k = j + 1 To lastRow
Cells(thisRow, 2).Value = Cells(i, 1).Value & ", " & Cells(j, 1).Value & ", " & Cells(k, 1).Value
thisRow = thisRow + 1
Next k
Next j
Next i

End Sub

 

[wideboydixon]

Public Sub GetUniquePairs()

Dim lastRow As Long
Dim thisRow As Long
Dim i As Long
Dim j As Long
Dim k As Long

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
thisRow = 1
For i = 1 To lastRow - 1
    For j = i + 1 To lastRow
        Cells(thisRow, 2).Value = Cells(i, 1).Value & ", " & Cells(j, 1).Value
        thisRow = thisRow + 1
        If j < lastRow Then
            For k = j + 1 To lastRow
                Cells(thisRow, 2).Value = Cells(i, 1).Value & ", " & Cells(j, 1).Value & ", " & Cells(k, 1).Value
                thisRow = thisRow + 1
            Next k
        End If
    Next j
Next i

End Sub

WBD