How to get all possible combinations of 3 columns into a 4th column?

[sami770]

Hey Guys,
I have a simple sheet with 3 columns:

Column A include a simple list of letters (a to z)
Column B include a simple list of letters (a to z)
Column C include a simple list of letters (a to z)

(See file attached)

Is it possible to create a macro that will produce ALL combinations into column D?

After running the macro - the final results (in column D) sould look like this:
aaa
aab
aac
.
.
.
zzz

Thanks,
Sami

[TMS]

Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
For i = 1 To 26
    For j = 1 To 26
        For k = 1 To 26
            l = l + 1
            Range("D" & l) = Range("A" & i) & _
                             Range("B" & j) & _
                             Range("C" & k)
        Next 'k
    Next 'j
Next 'i

Regards, TMS

[Pete_UK]

I think this is a situation where a macro is easier than a formula (and TMS has given you one), but just in case you want to try it with a formula, put this in D1:

=INDEX(A:A,MOD(INT(INT((ROWS($1:1)-1)/26)/26),26)+1)&INDEX(B:B,MOD(INT((ROWS($1:1)-1)/26),26)+1)&INDEX(C:C,MOD(ROWS($1:1)-1,26)+1)

and then copy it down to cell D17576 (i.e. the row given by 26 x 26 x 26).

Hope this helps.

Pete

[sami770]

Thanks a lot

Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
For i = 1 To 26
    For j = 1 To 26
        For k = 1 To 26
            l = l + 1
            Range("D" & l) = Range("A" & i) & _
                             Range("B" & j) & _
                             Range("C" & k)
        Next 'k
    Next 'j
Next 'i

Regards, TMS

[TMS]

You're welcome.



If you are satisfied with the solution(s) provided, please mark your thread as Solved.


New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save

[jbesclapez]

Hi guys,

Sorry to bring back to life a Zombie post :-)

I just tested the VBA on my problem and on my side it is not working because I have a slight difference compaired to the original question.
My 3 columns do not have exactly the same amounts of data. But all the rest is the same (columns, logic...)
So do someone know how this VBA could work "dynamically" with a different amount of data in each column?

Thanks

[jbesclapez]

I might have found a working macro but what is weird is sometime when i run it I get "subscript out of range" error

Hope this code will help someone and hope it will work for you guys. Anyone as the solution for this error?

Sub Combos()
Dim Element(), Index()
Dim MyCols As Variant, MySheet As Worksheet, OneCol As Boolean
Dim r As Long, c As Long, ctr As Long, mysize As Long
Dim delim As String, OutputCol As String, str1 As String

' Set up conditions
Set MySheet = Sheets("Sheet1")
MyCols = Array("A", "B", "C")
OutputCol = "F"
OneCol = True
delim = ""

' resize the arrays
ReDim Element(255, UBound(MyCols))
ReDim Index(UBound(MyCols))

' Read the elements
For c = 0 To UBound(MyCols)
Element(0, c) = 0
Index(c) = 1
For r = 1 To 255
If MySheet.Cells(r, MyCols(c)) <> "" Then
Element(0, c) = Element(0, c) + 1
Element(Element(0, c), c) = MySheet.Cells(r, MyCols(c))
End If
Next r
Next c

' Clear the output columns(s), and check for the number of results
ctr = MySheet.Cells(1, OutputCol).Column
mysize = 1
For c = 0 To UBound(MyCols)
mysize = mysize * Element(0, c)
MySheet.Columns(ctr).ClearContents
ctr = ctr + 1
Next c
If mysize > 1000000 Then
MsgBox "The number of results is too big to handle!"
Exit Sub
End If

ctr = 0

' Start creating combinations
Loop1:
ctr = ctr + 1
str1 = ""
Set resultcell = MySheet.Cells(ctr, OutputCol)
For c = 0 To UBound(MyCols)
If OneCol Then
str1 = str1 & Element(Index(c), c) & delim
Else
resultcell.Value = Element(Index(c), c)
Set resultcell = resultcell.Offset(0, 1)
End If
Next c
If OneCol Then MySheet.Cells(ctr, OutputCol) = Left(str1, Len(str1) - Len(delim))

' Increment the indices
For c = 0 To UBound(MyCols)
Index(c) = Index(c) + 1
If Index(c) <= Element(0, c) Then Exit For
Index(c) = 1
Next c
If c <= UBound(MyCols) Then GoTo Loop1:

End Sub

[TMS]

Unfortunately your post does not comply with Rule 2 of our Forum RULES. Do not post a question in the thread of another member -- start your own thread.

If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread.

Old threads are often only monitored by the original participants. New threads not only open you up to all possible participants again, they typically get faster response, too.