# Impossible: 4 or 5 columns permutation with limit of 11 in VBA Excel

#### pgc01

##### MrExcel MVP
Hi

This is much simpler.
If I understand correctly you just have to calculate the combinations of each food group and concatenate them.

What I don't understand is why you (or anyone) would want to write a list of hundreds of thousands of combinations.
It seems pointless, like those posts that ask to write all the lotto combinations.
Hi Nick

You did not answer why you'd want a list with hundreds of thousands of combinations.

This is a small program, however, and I had some free time yesterday and I did it anyway.

Still curious, what are you going to do with this?

With a setup similar to yours
- row 3 with the food group names
- below the name the number of food elements of that group in the combination
- below the number the list of food elements to choose from

The result in H3, down

Insert a new module and paste:

Code:
``````Option Explicit
Option Base 1

Dim vFICount As Variant
Dim vFI As Variant, vResult As Variant

Sub Test()
Dim r As Range
Dim vFICountT As Variant
Dim j As Long, lRow As Long

Set r = Range("B3:F4") ' table with food group names and food items count for each combination
vFICount = Application.Index(r.Rows(2).Value, 0)

' get the values of the food items
ReDim vFI(1 To r.Columns.Count)
ReDim vFICountT(1 To r.Columns.Count)
For j = 1 To UBound(vFI)
vFI(j) = Application.Transpose(Range(r(3, j), r(2, j).End(xlDown)).Value)
If Not IsArray(vFI(j)) Then vFI(j) = Array(vFI(j))
vFICountT(j) = UBound(vFI(j))
Next j
ReDim vResult(1 To Application.Product(Application.Combin(vFICountT, vFICount)), 1 To 1)

' get the combinations
comb "", 1, 1, 1, lRow

' write the result
Range("H3").Resize(UBound(vResult)).Value = vResult
End Sub

Sub comb(ByVal sComb As String, ByVal lFI As Long, ByVal lPos As Long, ByVal lInd As Long, ByRef lRow As Long)
Dim j As Long, s As String

For j = lInd To UBound(vFI(lFI))
s = sComb & ", " & vFI(lFI)(j)
If lPos = vFICount(lFI) Then
If lFI = UBound(vFICount) Then
lRow = lRow + 1
vResult(lRow, 1) = Mid(s, 3)
Else
comb s, lFI + 1, 1, 1, lRow
End If
Else
comb s, lFI, lPos + 1, j + 1, lRow
End If
Next j
End Sub``````

Ex.:

Last edited:

### Excel Facts

Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

1,106,239
Messages
5,509,991
Members
408,768
Latest member
ndg4405

### This Week's Hot Topics

• Turn fraction around
Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
• TIme Clock record reformatting to ???
Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
• TextBox Match
hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
• Using Large function based on Multiple Criteria
Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
• Can you check my code please
Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
• Combining 2 pivot tables into 1 chart
Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...