All possible combinations

[jt42cwr]

Hi,

I have a table, six rows across, 20 or so rows deep containing strings of text which I'd like to concatenate into one string. I would however like to be able to create every possible combination of a string from each column. The string in Column A is always the first string, plus the string in Column F is always the last with the others in between in sequence.

Does anyone know how this can be achieved with a macro?

 

[shg]

How about a formula-based solution?

[

      -----A----- ----B----- -----C------ ---D---- -----E----- -------F-------- G H I J K L M N O P Q R
  1   Phrase1     Phrase2    Phrase3      Phrase4  Phrase5     Phrase6          1 1 1 1 1 1 4 4 4 4 4 4
  2                                                                             2 2 3 3 4 4 1 1 2 2 3 3
  3                                                                             3 4 2 4 2 3 2 3 1 3 1 2
  4                                                                             4 3 4 2 3 2 3 2 3 1 2 1
  5   Now is the  time for   all good me  to come  to the aid  of their country

The formula in G5 and copied across an down (which is not shown above) is

=A5 & INDEX($B$5:$E$5, G$1) & INDEX($B$5:$E$5, G$2) & INDEX($B$5:$E$5, G$3) & INDEX($B$5:$E$5, G$4) & F5

There's a trailing blank in each of the phrases.

 

[jt42cwr]

Maybe I should have mentioned that each column has a different number of strings in it.

 

[Ruddles]

Easy. That's 20^6 or 64 million combinations. Where do you want them: in 64 separate worksheets or in a text file?

 

[Ruddles]

With your phrases in the first sheet, create a new second sheet and run this code:-

[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub AllCombinations()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys] Dim a, b, c, d, e, f, x
 
 ThisWorkbook.Sheets(2).Columns("a").ClearContents
 
 x = 0
 With ThisWorkbook.Sheets(1)
   For a = 1 To .Cells(.Rows.Count, "a").End(xlUp).Row
     For b = 1 To .Cells(.Rows.Count, "b").End(xlUp).Row
        For c = 1 To .Cells(.Rows.Count, "c").End(xlUp).Row
          For d = 1 To .Cells(.Rows.Count, "d").End(xlUp).Row
            For e = 1 To .Cells(.Rows.Count, "e").End(xlUp).Row
              For f = 1 To .Cells(.Rows.Count, "F").End(xlUp).Row
                x = x + 1
                ThisWorkbook.Sheets(2).Cells(x, 1) = _
                    .Cells(a, "a") & " " & .Cells(b, "b") & " " & .Cells(c, "c") & " " & _
                    .Cells(d, "d").Value & " " & .Cells(e, "e") & " " & .Cells(f, "f")
              Next f
            Next e
          Next d
        Next c
      Next b
    Next a
  End With
  
  MsgBox Format(x, "#,###") & " combinations written to " & Sheets(2).Name, _
         vbOKOnly + vbInformation
  
End Sub
[/FONT]

As a worksheet only contains a maximum of one million rows, the code will fall over if you exceed one million combinations. The code which writes to Sheets(2) could almost as easily write to a text file.

Let me know...

 

[Ruddles]

Or to write to a file:-

[FONT=Fixedsys]Option Explicit[/FONT]
 
[FONT=Fixedsys]Public Sub AllCombinationsToFile()[/FONT]
 
[FONT=Fixedsys] Dim a, b, c, d, e, f, x[/FONT]
[FONT=Fixedsys] Dim sFileName As Variant[/FONT]
[FONT=Fixedsys] Dim iFH As Integer[/FONT]
 
[FONT=Fixedsys] sFileName = Application.GetSaveAsFilename(FileFilter:="Text files (*.txt), *.txt)")[/FONT]
[FONT=Fixedsys] If sFileName = "False" Then Exit Sub[/FONT]
 
[FONT=Fixedsys] iFH = FreeFile()[/FONT]
[FONT=Fixedsys] Open sFileName For Output As #iFH[/FONT]
[FONT=Fixedsys] x = 0[/FONT]
[FONT=Fixedsys] With ThisWorkbook.Sheets(1)[/FONT]
[FONT=Fixedsys]   For a = 1 To .Cells(.Rows.Count, "a").End(xlUp).Row[/FONT]
[FONT=Fixedsys]     For b = 1 To .Cells(.Rows.Count, "b").End(xlUp).Row[/FONT]
[FONT=Fixedsys]       For c = 1 To .Cells(.Rows.Count, "c").End(xlUp).Row[/FONT]
[FONT=Fixedsys]         For d = 1 To .Cells(.Rows.Count, "d").End(xlUp).Row[/FONT]
[FONT=Fixedsys]           For e = 1 To .Cells(.Rows.Count, "e").End(xlUp).Row[/FONT]
[FONT=Fixedsys]             For f = 1 To .Cells(.Rows.Count, "F").End(xlUp).Row[/FONT]
[FONT=Fixedsys]               x = x + 1[/FONT]
[FONT=Fixedsys]               Print #iFH, .Cells(a, "a") & " " & .Cells(b, "b") & " " & _[/FONT]
[FONT=Fixedsys]                         .Cells(c, "c") & " " & .Cells(d, "d").Value & " " & _[/FONT]
[FONT=Fixedsys]                         .Cells(e, "e") & " " & .Cells(f, "f")[/FONT]
[FONT=Fixedsys]             Next f[/FONT]
[FONT=Fixedsys]           Next e[/FONT]
[FONT=Fixedsys]         Next d[/FONT]
[FONT=Fixedsys]       Next c[/FONT]
[FONT=Fixedsys]     Next b[/FONT]
[FONT=Fixedsys]   Next a[/FONT]
[FONT=Fixedsys] End With[/FONT]
[FONT=Fixedsys] Close #iFH[/FONT]
 
[FONT=Fixedsys] MsgBox Format(x, "#,###") & " combinations written to " & sFileName, _[/FONT]
[FONT=Fixedsys]        vbOKOnly + vbInformation[/FONT]
 
[FONT=Fixedsys]End Sub[/FONT]

 

[pgc01]

Hi

Just out of curiosity, why would you want to write the 60+ million strings in a file?

 

[jt42cwr]

Just out of curiosity, why would you want to write the 60+ million strings in a file?

The strings are URL's, I'll leave the rest to your imagination

 

[Ruddles]

How did you get on with my code?

 

[jt42cwr]

Spot on, thank you.