Need a Macro to create all possible combination of Words from a linear list

Hi,

take a look this pic.

data in columns A and B

results from cell D2 and to the right and down

note

max number of entries is 9 (A2:A10)

pic1 (1st section)

pic2 (last section)

from this url address

http://www.mrexcel.com/forum/excel-questions/956932-visual-basic-applications-list-all-possible-permutations-2.html

vba macro

Option Explicit

' PGC - AUG 2016

' Permutation with repetition and with restrictions.

' A set of distinguishable objects is given, as well and the number of times each one is repeated

' Ex. Permutations with repetition with 2 "a"'s, 1 "b" and 2 "c"'s

' Input in a nx2 table, first columns the elements and second column how many times they repeat

'

'

Sub PermMultRep()

Dim vIn As Variant, vPerms As Variant, vPerm As Variant

Dim lRow As Long

'

'###tasosk

If Range("A2", Range("A2").End(xlDown)).Rows.Count > 9 Then

MsgBox "wrong, max number of entries is 9"

Exit Sub

End If

Range("A2", Range("A2").End(xlDown)).Offset(, 1) = 1 'qty =1

'###

'

vIn = Range("A2", Range("A2").End(xlDown)).Resize(, 2).Value ' table of elements and number of times they repeat

ReDim vPerm(1 To Application.Sum(Application.Index(vIn, 0, 2))) ' array for the current permutation

ReDim vPerms(1 To Application.MultiNomial(Application.Index(vIn, 0, 2)), 1 To UBound(vPerm)) 'array to store all permutations

PermMultRep1 vIn, vPerm, vPerms, 1, lRow ' calculate all the permutations into the vPerms array

'Columns("D").Resize(, UBound(vPerm) + 1).Clear ' clears columns for the output

Range("D2").CurrentRegion.ClearContents ' tasosk

Range("D2").Resize(UBound(vPerms, 1), UBound(vPerms, 2)).Value = vPerms ' writes the output in D2, down and across

End Sub

'

'

Sub PermMultRep1(ByVal vIn As Variant, vPerm As Variant, vPerms As Variant, ByVal lInd As Long, lRow As Long)

Dim j As Long, lCol As Long

Dim v1 As Variant

For j = LBound(vIn, 1) To UBound(vIn, 1)

    If vIn(j, 2) > 0 Then

        vPerm(lInd) = vIn(j, 1)

        If lInd = UBound(vPerm) Then

            lRow = lRow + 1

            For lCol = 1 To UBound(vPerm)

                vPerms(lRow, lCol) = vPerm(lCol)

            Next lCol

        Else

            v1 = vIn

            v1(j, 2) = v1(j, 2) - 1

            PermMultRep1 v1, vPerm, vPerms, lInd + 1, lRow

        End If

    End If

Next j

End Sub

add the first 7 rows together in Mike's answer:

792,100  unique results.

How did you come up with an extimate of 50K-100K

5 words generates  36,100  sets

6 words generates  187,300 sets

as you can see from Mike's data.

--

Regards,

Tom Ogilvy

Hi Mike,

Oh shoot, really? Actually We are expecting around 50K-100K only. How about upto 7 combinations only?

Thank you so much for your help!

All the best,

Jaeson

Hi,

Looking at your workbook you seem to want the permutations of 1 (10 permutations),2 (90 Permutations), 3 (720 permutations) etc up to 10 (>3 million permutations) and that's an awful lot of permutations, see the snip below, more than 9 million. I could of course of misunderstood but perhaps you could clarify/simplify the problem.