How to generate permutated number ?

[ryan8200]

If I type 1234, excel with generate & permutate 24 sets of numbers like 1234,1243,1324,1342,1423,1432, 2134,2143, 2314,2341, 2413,2431,3124,3142,3214,3241,3412,3421,4123, 4132,4213,4231,4312,4321.

Is that possible to conduct in Excel ?

 

[ryan8200]

What should I modify, if i want to key in the number I want and list out the possible permutated numbers in excel ?

 

[mirabeau]

I take it, since you didn't indicate otherwise, that the code provided did answer your specific request to produce all combinations of 4 numbers (1 to 4 in this case) without repetition.

If you want this done for other sets of numbers then

(a) what's the most you're likely to request at once? (4, or 9, or 78 or whatever?). You may run into limitations of computer memory with a lot, just like another suggested code gave overflow problems.

(b) do you want the results to include only unique numbers? e.g. if you key in 32276, do you want the resulting permutations to include two 2's, or only one?

(c) are your numbers to permute just single digits (from 0 to 9) or do you also envisage numbers like 17, 564, 10^12+3, etc.?

 

[mikerickson]

Here's a sub that will get you started.
Input n into the dialog and will print out the n! permuations of {1,2,3,...n}.
You should be aware that things get really big and slow around n=8

Sub test()
    Dim resultArray As Variant
    Dim tempArray() As Long
    Dim Size As Long
    Dim i As Long, lastFixed As Long, pointer As Long
    Dim lowTrans As Long, highTrans As Long
    
    Size = Application.InputBox("How many?", Default:=5, Type:=1)
    If Size < 1 Then Exit Sub
    
    ReDim resultArray(1 To fact(Size))

    ReDim tempArray(1 To Size)
    For i = 1 To Size
        tempArray(i) = i
    Next i
    resultArray(1) = tempArray
    pointer = 1
    
    lastFixed = 1
    highTrans = 2
    
    Do Until Size < highTrans
         lowTrans = 1
        Do Until lowTrans = highTrans
            For i = 1 To lastFixed
                tempArray = resultArray(i)
                tempArray(lowTrans) = resultArray(i)(highTrans)
                tempArray(highTrans) = resultArray(i)(lowTrans)
                pointer = pointer + 1
                resultArray(pointer) = tempArray
            Next i
            lowTrans = lowTrans + 1
        Loop
        lastFixed = pointer
        highTrans = highTrans + 1
    Loop
    
    With Sheet1
        .Cells.ClearContents
        For i = 1 To fact(Size)
            .Range("A1").Offset(i, 0).Resize(1, Size) = resultArray(i)
        Next i
    End With
End Sub

Function fact(a)
    If a <= 1 Then
        fact = 1
    Else
        fact = a * fact(a - 1)
    End If
End Function

Why do you want this printed out?
These can be calculated, why print them out?
What is the purpose of this exercise?
I'd betting that you can achieve your ultimate goal faster and easier by analysis than by listing all the possibilites.

(If your trying to beat the lottery, just use RAND)

 

[ryan8200]

The code should be able to list out all possible permutated numbers.


No permutation (0000,....9999) terminate the listing
permutation 4 (0001 ) lists out 4 pairs of numbers (0001,0010,0100,1000)
permutation 6 (1122) lists out 6 pairs of numbers (1122,1212,1221,2112,2121,2211)
permutation 12 (0122) lists out 12 pairs of numbers

And
permutation 24 (0122) lists out 24 pairs of numbers

 

[mikerickson]

What are you doing with this list?
00000 is not a "no permutation"

What are you doing with this list?

 

[ryan8200]

What are you doing with this list?
00000 is not a "no permutation"

What are you doing with this list?

Numbers with same digits cannot be permutated... No matter how you arrange, it still 0000.

 

[mikerickson]

I've been thinking about this and your other posting?

What you are dealing with is arrays of {0,1,2,..,9}
Here we are dealing with n=4
Each of your sub sets could be represented by one element A1, A2, A3, A4 such that Ai <= A(i+1)
so 0000 would be a representative
0001 would be a representative
0010 would not.

So how many sub sets are there.

there are 10 choices for the first element
Having chosen A1, there are (10-A1) choices for the second
Having chosen A2, there are (10-A2) choices for the third.
etc.

I haven't had time to work further on this, but I think it would be more fruitful than working with permutations. The factorial increase in size is so steep, that I always look for some alternative to "all permuations".

What is the question that you want anwered?

 

[ryan8200]

I want code that is able to permutate & list out the number that I type without repetition

Total element that I can type = 10,000 ranging from 0000,0001....9998 & 9999

Conditions:
No permutation: 0000,1111,....8888,9999 (Terminate the listing or return blank in excel)

Permutation 4 : 0001....(List out 4 numbers without repetition:0001,0010,0100 &1000)

Permutation 6: 1122...(List out 6 numbers without repetition:1122, 1212,1221,2112,2121,2211)

Permutation 12: 1223...(List out 12 numbers without repetition)

Permutation 24: 1234...(List out 24 numbers without repetition)



A2, B2, C2, D2 are the respective digits


SUM(IF(A2=B2,1,0),IF(A2=C2,1,0),IF(A2=D2,1,0),IF(B2=C2,1,0),IF(B2=D2,1,0),IF(C2=D2,1,)) =6 => do no permutation

SUM(IF(A2=B2,1,0),IF(A2=C2,1,0),IF(A2=D2,1,0),IF(B2=C2,1,0),IF(B2=D2,1,0),IF(C2=D2,1,)) =3 => do permutation 4

SUM(IF(A2=B2,1,0),IF(A2=C2,1,0),IF(A2=D2,1,0),IF(B2=C2,1,0),IF(B2=D2,1,0),IF(C2=D2,1,)) =2 =>do permutation 6

SUM(IF(A2=B2,1,0),IF(A2=C2,1,0),IF(A2=D2,1,0),IF(B2=C2,1,0),IF(B2=D2,1,0),IF(C2=D2,1,)) =1 =>do permutation 12

SUM(IF(A2=B2,1,0),IF(A2=C2,1,0),IF(A2=D2,1,0),IF(B2=C2,1,0),IF(B2=D2,1,0),IF(C2=D2,1,)) = 0 => do permutation 24

I hope that give you a clear clarification

 

[mikerickson]

This is a rather brute force approach but you could use this UDF.
Select F1:I24 and enter the array formula =UniquePermutes(A2:D2)

This should be entered with Ctrl-Shift-Enter.
Different size ranges can be used.

Function UniquePermutes(BaseArray As Variant)
    Dim Permuting As Variant
    Dim i As Long, j As Long, Pointer As Long
    Dim resultArray() As Variant
    Dim scoreKeeper() As String
    Dim tempArray As Variant
    
    If TypeName(BaseArray) = "Range" Then
        If BaseArray.Cells.Count = 1 Then
            BaseArray = Array(BaseArray.Value)
        ElseIf BaseArray.Rows.Count = 1 Then
            BaseArray = Application.Transpose(Application.Transpose(BaseArray.Value))
        ElseIf BaseArray.Columns.Count = 1 Then
            BaseArray = Application.Transpose(BaseArray.Value)
        Else
            UniquePermutes = CVErr(xlErrValue)
        End If
    ElseIf Not (BaseArray) Like "*()" Then
        UniquePermutes = CVErr(xlErrNum)
    End If
    
    Permuting = Permutations(UBound(BaseArray))
    
    ReDim resultArray(1 To UBound(Permuting))
    ReDim scoreKeeper(1 To UBound(Permuting))
    
    tempArray = BaseArray
    For i = 1 To UBound(Permuting)
        For j = 1 To UBound(tempArray)
            tempArray(j) = BaseArray(Permuting(i)(j))
        Next j
        If IsError(Application.Match(Join(tempArray), scoreKeeper, 0)) Then
            Pointer = Pointer + 1
            scoreKeeper(Pointer) = Join(tempArray)
            resultArray(Pointer) = tempArray
        End If
    Next i
    ReDim Preserve resultArray(1 To Pointer)
    
    UniquePermutes = resultArray
End Function

Function Permutations(Size As Long) As Variant
    Dim resultArray As Variant
    Dim tempArray() As Long
    Dim i As Long, lastFixed As Long, Pointer As Long
    Dim lowTrans As Long, highTrans As Long
    
    If Size < 1 Then Exit Function
    
    ReDim resultArray(1 To fact(Size))

    ReDim tempArray(1 To Size)
    For i = 1 To Size
        tempArray(i) = i
    Next i
    resultArray(1) = tempArray
    Pointer = 1
    
    lastFixed = 1
    highTrans = 2
    
    Do Until Size < highTrans
         lowTrans = 1
        Do Until lowTrans = highTrans
            For i = 1 To lastFixed
                tempArray = resultArray(i)
                tempArray(lowTrans) = resultArray(i)(highTrans)
                tempArray(highTrans) = resultArray(i)(lowTrans)
                Pointer = Pointer + 1
                resultArray(Pointer) = tempArray
            Next i
            lowTrans = lowTrans + 1
        Loop
        lastFixed = Pointer
        highTrans = highTrans + 1
    Loop
    
    Permutations = resultArray
End Function

Function fact(a)
    If a <= 1 Then
        fact = 1
    Else
        fact = a * fact(a - 1)
    End If
End Function

 

[ryan8200]

I would like to modify the code, so that message box prompt out and ask me to enter the number.

Is that possible to joint the string (output) using CONCATENATE function....
and leave the #N/A cell blank ?