Generate A Permutation List no Macros! if possible- Excel

[faditaouk]

I need a set of formulas to list all 720 permutations of the numbers 1,2,3,4,5,6, if it can't be done by a formula then it has to be in macro. May anyone help!

 

[baitmaster]

welcome to the board

are duplicated results included or excluded? e.g. 6,5,4,3,2,1 and 1,2,3,4,5,6

 

[baitmaster]

Please ignore previous post. I'm confusing several subjects and the question is stupid...

 

[S.H.A.D.O.]

I need a set of formulas to list all 720 permutations of the numbers 1,2,3,4,5,6, if it can't be done by a formula then it has to be in macro. May anyone help!

Hi faditaouk, welcome to the board.

Give this VBA approach a go. Enter the numbers 1 to 6 in cells A1:A6 and run the code.

Sub Permutations_6_From_6()
    Dim rRng As Range
    Dim lRow As Long
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With
    Range("C:H").ClearContents
    Set rRng = Range("A1", Range("A1").End(xlDown))
    For P1 = 1 To rRng.Count
        For P2 = 1 To rRng.Count
            For P3 = 1 To rRng.Count
                For P4 = 1 To rRng.Count
                    For P5 = 1 To rRng.Count
                        For P6 = 1 To rRng.Count
                            If _
                                P1 <> P2 And _
                                P1 <> P3 And _
                                P1 <> P4 And _
                                P1 <> P5 And _
                                P1 <> P6 And _
                                P2 <> P3 And _
                                P2 <> P4 And _
                                P2 <> P5 And _
                                P2 <> P6 And _
                                P3 <> P4 And _
                                P3 <> P5 And _
                                P3 <> P6 And _
                                P4 <> P5 And _
                                P4 <> P6 And _
                                P5 <> P6 Then
                                lRow = lRow + 1
                                Range("C" & lRow) = Range("A" & P1)
                                Range("D" & lRow) = Range("A" & P2)
                                Range("E" & lRow) = Range("A" & P3)
                                Range("F" & lRow) = Range("A" & P4)
                                Range("G" & lRow) = Range("A" & P5)
                                Range("H" & lRow) = Range("A" & P6)
                            End If
                        Next P6
                    Next P5
                Next P4
            Next P3
        Next P2
    Next P1
    Range("A1").Select
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

I hope this helps!

 

[baitmaster]

I specifically wanted an algorithm that was extendable to any set of numbers; turned out this was a particularly horrible one for me. I had a look at Heap's Algorithm but haven't had enough coffee to tackle it properly so I abandoned it before it annoyed me too much. I've instead gone for an iterative approach as described in the "Generation in lexicographic order" section at https://en.wikipedia.org/wiki/Permutation

Code as follows

Option Explicit

Sub permute()

Const num As Integer = 6
Dim i As Integer, j As Integer, iCount As Integer
Dim K As Integer, L As Integer
Dim foundK As Boolean

Dim arrResults()
ReDim arrResults(1 To num, 1 To 1)

Dim arrTempResults()
ReDim arrTempResults(1 To num, 1 To 1)

' generate first permutation
For j = 1 To num
    arrResults(j, 1) = j
Next j

nextLoop:
iCount = iCount + 1

' 1.Find the largest index k such that a[k] < a[k + 1]. If no such index exists, the permutation is the last permutation.
foundK = False
For j = num To 2 Step -1
    If arrResults(j, iCount) > arrResults(j - 1, iCount) Then
        K = j - 1
        foundK = True
        Exit For
    End If
Next j

If Not foundK Then GoTo algorithmEnd

' 2.Find the largest index l greater than k such that a[k] < a[l].
For j = K To num
    If arrResults(j, iCount) > arrResults(K, iCount) Then L = j
Next j

' 3.Swap the value of a[k] with that of a[l].
For j = 1 To num
    arrTempResults(j, 1) = arrResults(j, iCount)
Next j
arrTempResults(K, 1) = arrResults(L, iCount)
arrTempResults(L, 1) = arrResults(K, iCount)

' 4.Reverse the sequence from a[k + 1] up to and including the final element a[n].
ReDim Preserve arrResults(1 To num, 1 To iCount + 1)

Debug.Print K, L, "/", arrTempResults(1, 1), arrTempResults(2, 1), arrTempResults(3, 1), arrTempResults(4, 1)

For j = 1 To K
    arrResults(j, iCount + 1) = arrTempResults(j, 1)
Next j
For j = K + 1 To num
    arrResults(j, iCount + 1) = arrTempResults(num - j + K + 1, 1)
Next j

' error prevention during test:
'If iCount = 24 Then GoTo algorithmEnd

GoTo nextLoop

algorithmEnd:
Range("A1").Resize(UBound(arrResults, 1), UBound(arrResults, 2)) = arrResults
End Sub

 

[XOR LX]

If you want a formula-based solution, then enter this formula into a cell of your choice:

=MODE.MULT(IF(MMULT(0+ISNUMBER(FIND({1,2,3,4,5,6},ROW(INDEX($A:$A,123456):INDEX($A:$A,654321)))),{1;1;1;1;1;1})={6,6},ROW(INDEX($A:$A,123456):INDEX($A:$A,654321))))

Now go into the formula bar, highlight the entire formula and press F9. This should convert the above to a large array, beginning:

={123456;123465;123546;123564;123645;123654;124356;124365;124536;124563;124635;124653;125346;125364;125436;125463;125634;125643;126345;126354;126435;126453;126534;...}

etc.

Still in the formula bar, amend the above to:

=INDEX({123456;123465;123546;123564;123645;123654;124356;124365;124536;124563;124635;124653;125346;125364;125436;125463;125634;125643;126345;126354;126435;126453;126534;...},ROWS($1:1))

making sure that the ROWS($1:1) part comes at the very end of the large array, and press ENTER.

Now copy this formula down a further 719 rows.

Note that we could instead array-enter** the formula:

=INDEX(MODE.MULT(IF(MMULT(0+ISNUMBER(FIND({1,2,3,4,5,6},ROW(INDEX($A:$A,123456):INDEX($A:$A,654321)))),{1;1;1;1;1;1})={6,6},ROW(INDEX($A:$A,123456):INDEX($A:$A,654321)))),ROWS($1:1))

into a single cell and then copy down, i.e. without first converting to a static array, though this way you'll find that Excel takes a few minutes to calculate everything.

Regards


**Array formulas are not entered in the same way as 'standard' formulas. Instead of pressing just ENTER, you first hold down CTRL and SHIFT, and only then press ENTER. If you've done it correctly, you'll notice Excel puts curly brackets {} around the formula (though do not attempt to manually insert these yourself).

 

[MarcelBeug]

Great solution XOR LX. I'll keep that in mind for timesaving solutions, avoiding array formulas.

2 Suggestions:
1. Start by entering the complete formula (so the last one). While in the formula bar, put the cursor after the first parenthesis, click "array" in the popup below (the one for INDEX syntax), press F9 (wait a moment) and Enter.
2. The resulting formula is 5000+ characters, so this would be the maximum possible number of permutations achievable with this formula; in other words 1-7 would result in a formula exceeding the limit of 8192 characters.

 

[XOR LX]

Great solution XOR LX. I'll keep that in mind for timesaving solutions, avoiding array formulas.

2 Suggestions:
1. Start by entering the complete formula (so the last one). While in the formula bar, put the cursor after the first parenthesis, click "array" in the popup below (the one for INDEX syntax), press F9 (wait a moment) and Enter.
2. The resulting formula is 5000+ characters, so this would be the maximum possible number of permutations achievable with this formula; in other words 1-7 would result in a formula exceeding the limit of 8192 characters.

Thanks, Marcel!

Actually, for permutations of more than 6 digits, we cannot in any case employ this method, since it depends on use of the ROW function for generating those permutations, and of course

ROW(1234567)

for example, which would be required for the equivalent 7-digit set-up, would exceed Excel's limitations on that function.

VBA is of course best here, though I just thought it might be interesting from a theoretical point of view to give the formula-based solution.

Regards

 

[S.H.A.D.O.]

That's strange, it doesn't work for me, I get...

=INDEX(#NAME?,ROWS($1:1))

 

[XOR LX]

That's strange, it doesn't work for me, I get...

=INDEX(#NAME?,ROWS($1:1))

You must have done something wrong along the way.

Regards