Combine all possible combinations from single column without vba

andrew_milonavic

Board Regular
Joined
Nov 16, 2016
Messages
98
Hi Everyone,

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

I was able to find this formula
Code:
=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
 
Or, if you're prepared to have helper columns:


Book1
ABCD
1Ant12Ant,Bear
2Bear13Ant,Cat
3Cat14Ant,Dog
4Dog15Ant,Elephant
5Elephant16Ant,Frog
6Frog17Ant,Gorilla
7Gorilla23Bear,Cat
824Bear,Dog
925Bear,Elephant
1026Bear,Frog
1127Bear,Gorilla
1234Cat,Dog
1335Cat,Elephant
1436Cat,Frog
1537Cat,Gorilla
1645Dog,Elephant
1746Dog,Frog
1847Dog,Gorilla
1956Elephant,Frog
2057Elephant,Gorilla
2167Frog,Gorilla
Sheet1
Cell Formulas
RangeFormula
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
 
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
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
 
Upvote 0
Trying to think about doing that in a formula gives me a headache. Trivial task for VBA though:

Code:
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.


[TABLE="width: 320"]
<colgroup><col width="64" span="5" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 64"]Size[/TD]
[TD="class: xl63, width: 64"]Type[/TD]
[TD="class: xl63, width: 64"]Rating[/TD]
[TD="class: xl63, width: 64"]Length[/TD]
[TD="class: xl63, width: 64"][/TD]
[/TR]
[TR]
[TD="class: xl63"]2[/TD]
[TD="class: xl63"]RF[/TD]
[TD="class: xl63"]150[/TD]
[TD="class: xl63"]8[/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"]4[/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"]300[/TD]
[TD="class: xl63"]10[/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"]6[/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"]12[/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"]8[/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"]10[/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"]12[/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"]14[/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[/TR]
[TR]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[TD="class: xl63"][/TD]
[/TR]
</tbody>[/TABLE]
Like if you have 4 rows like that, the 1st results would be 2RF1508 then 2RF15010 then 2RF15012 then 2RF3008....and so on?

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

Code:
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!
 
Upvote 0
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:

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.
 
Upvote 0
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?

[TABLE="class: grid, width: 10"]
<tbody>[TR]
[TD]Ant[/TD]
[TD]Ant, Bear[/TD]
[/TR]
[TR]
[TD]Bear[/TD]
[TD]Ant, Bear, Cat[/TD]
[/TR]
[TR]
[TD]Cat[/TD]
[TD]Ant, Bear, Dog[/TD]
[/TR]
[TR]
[TD]Dog[/TD]
[TD]Ant, Cat[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Ant, Cat, Dog[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,123
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top