Combining Text in Columsn

[mattisokayatexcel]

Hi,

I've found variations of what I'm looking for in the group, but
nothing that's an exact fit.

I'm trying to produce a macro that would output all combinations of
words from multiple lists. So, for example, if a sheet contains the
following two lists:

A B
1 happy cow
2 sad dog
3 angry cat

The code would produce the following list in Column C (words separated
by a space).

C
1 happy cow
2 happy dog
3 happy cat
4 sad cow
5 sad dog
6 sad cat
7 angry cow
8 angry dog
9 angry cat

The macro should be able to perform this routine for two, three, or
four columns of words (placing the completed list in the column
immediately to the right of the last list).

Any ideas how to do this?

Thanks!

 

[Guest]

This assumes the same number of words in each column.

Sub Combinations()
Dim i As Long, j As Long
Dim k As Long, l As Long
Dim rw As Long, s As String
Dim s1 As String, s3 As String
Dim rwCnt As Long, numwords As Long
' words are in row 1 to rwCnt
rwCnt = 3
'specify how many columns of words
numwords = 4
rw = 1
For i = 1 To rwCnt
For j = 1 To rwCnt
s = Cells(i, 1) & " " & Cells(j, 2)
If numwords = 2 Then
Cells(rw, 3).Value = s: rw = rw + 1
Else
For k = 1 To rwCnt
s1 = s & " " & Cells(k, 3)
If numwords = 3 Then
Cells(rw, 4).Value = s1: rw = rw + 1
Else
For l = 1 To rwCnt
s2 = s1 & " " & Cells(l, 4)
Cells(rw, 5).Value = s2: rw = rw + 1
Next l
End If
Next k
End If
Next j
Next i
End Sub

It handles two, three or four columns of words.

 

[squenson via OfficeKB.com]

Here is a macro that does it for up to 6 columns. The list of words starts in
row 1 and there should not be blank. Results are copied in column G.

Sub GenerateSentences()

Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
Dim i4 As Long
Dim i5 As Long
Dim i6 As Long

i1 = 1
i2 = 1
i3 = 1
i4 = 1
i5 = 1
i6 = 1
j = 1
While Cells(i1, 1) <> "" Or i1 = 1
While Cells(i2, 2) <> "" Or i2 = 1
While Cells(i3, 3) <> "" Or i3 = 1
While Cells(i4, 4) <> "" Or i4 = 1
While Cells(i5, 5) <> "" Or i5 = 1
While Cells(i6, 6) <> "" Or i6 = 1
Cells(j, 7) = Trim(Cells(i1, 1) & _
" " & Cells(i2, 2) & " " & Cells(i3, 3) & " " & _
Cells(i4, 4) & " " & Cells(i5, 5) & " " & Cells(i6, 6))
j = j + 1
i6 = i6 + 1
Wend
i6 = 1
i5 = i5 + 1
Wend
i5 = 1
i4 = i4 + 1
Wend
i4 = 1
i3 = i3 + 1
Wend
i3 = 1
i2 = i2 + 1
Wend
i2 = 1
i1 = i1 + 1
Wend

End Sub

 

[Dana DeLouis]

I'm trying to produce a macro that would output all

combinations of words from multiple lists. So,

Hi. Here's another of many ways to do an "Outer" function.
This example is on 3 columns, but you can do more.

Sub YourMainCode()
Dim v
v = Outer([A1:A3], [B1:B2], [C1:C4])
[D1].Resize(UBound(v)) = v
[D].EntireColumn.AutoFit
End Sub

Function Outer(ParamArray v() As Variant)
'// Dana DeLouis
Dim C As Long
Dim J As Long
Dim K As Long
Dim s As String
Dim Sp As String
Dim R As Variant
Dim N As Variant
Dim d As Variant

Sp = Space(1)
Set d = CreateObject("Scripting.Dictionary")

R = T1(v(0))
For C = 1 To UBound(v)
N = T1(v(C))
For J = LBound(R) To UBound(R)
For K = LBound(N) To UBound(N)
s = R(J) & Sp & N(K)
d.Add d.Count, s
Next K
Next J
R = d.Items
d.RemoveAll
Next C
Set d = Nothing
Outer = T1(R)
End Function

Private Function T1(v)
' Transpose 1 time.
T1 = WorksheetFunction.Transpose(v)
End Function

 

[mattisokayatexcel]

This assumes the same number of words in each column.

Sub Combinations()
Dim i As Long, j As Long
Dim k As Long, l As Long
Dim rw As Long, s As String
Dim s1 As String, s3 As String
Dim rwCnt As Long, numwords As Long
' words are in row 1 to rwCnt
rwCnt = 3
'specify how many columns of words
numwords = 4
rw = 1
For i = 1 To rwCnt
For j = 1 To rwCnt
s = Cells(i, 1) & " " & Cells(j, 2)
If numwords = 2 Then
Cells(rw, 3).Value = s: rw = rw + 1
Else
For k = 1 To rwCnt
s1 = s & " " & Cells(k, 3)
If numwords = 3 Then
Cells(rw, 4).Value = s1: rw = rw + 1
Else
For l = 1 To rwCnt
s2 = s1 & " " & Cells(l, 4)
Cells(rw, 5).Value = s2: rw = rw + 1
Next l
End If
Next k
End If
Next j
Next i
End Sub

It handles two, three or four columns of words.

This is great! Thanks, Tom!

 

[mattisokayatexcel]

I'm trying to produce a macro that would output all
combinations of words from multiple lists. So,

Hi. Here's another of many ways to do an "Outer" function.
This example is on 3 columns, but you can do more.

Sub YourMainCode()
Dim v
v = Outer([A1:A3], [B1:B2], [C1:C4])
[D1].Resize(UBound(v)) = v
[D].EntireColumn.AutoFit
End Sub

Function Outer(ParamArray v() As Variant)
'// Dana DeLouis
Dim C As Long
Dim J As Long
Dim K As Long
Dim s As String
Dim Sp As String
Dim R As Variant
Dim N As Variant
Dim d As Variant

Sp = Space(1)
Set d = CreateObject("Scripting.Dictionary")

R = T1(v(0))
For C = 1 To UBound(v)
N = T1(v(C))
For J = LBound(R) To UBound(R)
For K = LBound(N) To UBound(N)
s = R(J) & Sp & N(K)
d.Add d.Count, s
Next K
Next J
R = d.Items
d.RemoveAll
Next C
Set d = Nothing
Outer = T1(R)
End Function

Private Function T1(v)
' Transpose 1 time.
T1 = WorksheetFunction.Transpose(v)
End Function

--
HTH :>)
Dana DeLouis
Windows XP & Excel 2007

Hi,

I've found variations of what I'm looking for in the group, but
nothing that's an exact fit.

I'm trying to produce a macro that would output all combinations of
words from multiple lists. So, for example, if a sheet contains the
following two lists:

A B
1 happy cow
2 sad dog
3 angry cat

The code would produce the following list in Column C (words separated
by a space).

C
1 happy cow
2 happy dog
3 happy cat
4 sad cow
5 sad dog
6 sad cat
7 angry cow
8 angry dog
9 angry cat

The macro should be able to perform this routine for two, three, or
four columns of words (placing the completed list in the column
immediately to the right of the last list).

Any ideas how to do this?

Thanks!

This works great. Thanks so much!

 

[mattisokayatexcel]

Here is a macro that does it for up to 6 columns. The list of words starts in
row 1 and there should not be blank. Results are copied in column G.

Sub GenerateSentences()

Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
Dim i4 As Long
Dim i5 As Long
Dim i6 As Long

i1 = 1
i2 = 1
i3 = 1
i4 = 1
i5 = 1
i6 = 1
j = 1
While Cells(i1, 1) <> "" Or i1 = 1
While Cells(i2, 2) <> "" Or i2 = 1
While Cells(i3, 3) <> "" Or i3 = 1
While Cells(i4, 4) <> "" Or i4 = 1
While Cells(i5, 5) <> "" Or i5 = 1
While Cells(i6, 6) <> "" Or i6 = 1
Cells(j, 7) = Trim(Cells(i1, 1) & _
" " & Cells(i2, 2) & " " & Cells(i3, 3) & " " & _
Cells(i4, 4) & " " & Cells(i5, 5) & " " & Cells(i6, 6))
j = j + 1
i6 = i6 + 1
Wend
i6 = 1
i5 = i5 + 1
Wend
i5 = 1
i4 = i4 + 1
Wend
i4 = 1
i3 = i3 + 1
Wend
i3 = 1
i2 = i2 + 1
Wend
i2 = 1
i1 = i1 + 1
Wend

End Sub

This is phenomenal! Exactly what I was looking for.

I modified the code slightly so that it only handles between two and
four columns of words (see below; there shouldn't be more than this).
On a slightly cosmetic note, is there a way to paste the completed
list two columns to the right of the last list of words, instead of in
column G? So, if there are two columns of words, the final list will
appear in column D; if there are three columns, it will show up in
column E; if there are four, it will be in column F.

Thanks!

Modified:

Sub GenerateSentences()

Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
Dim i4 As Long

i1 = 1
i2 = 1
i3 = 1
i4 = 1
J = 1
While Cells(i1, 1) <> "" Or i1 = 1
While Cells(i2, 2) <> "" Or i2 = 1
While Cells(i3, 3) <> "" Or i3 = 1
While Cells(i4, 4) <> "" Or i4 = 1
Cells(J, 5) = Trim(Cells(i1, 1) & _
" " & Cells(i2, 2) & " " & Cells(i3, 3) & " " & _
Cells(i4, 4))
J = J + 1
i4 = i4 + 1
Wend
i4 = 1
i3 = i3 + 1
Wend
i3 = 1
i2 = i2 + 1
Wend
i2 = 1
i1 = i1 + 1
Wend

End Sub

 

[Guest]

at the end of the macro, delete the columns you don't want.

 

[mattisokayatexcel]

at the end of the macro, delete the columns you don't want.

How would I have the macro find the last column from the left with
text, then insert the outputted list two columns to the right of this?