permutations

[ANANKE]

Hi,

I have 7 elements in A called a b c d e f g and I would need to have all the possible permutations (7!) in excel.
The strings should not contain repetitions of elements.

Can somebody help me?

Thanks for all suggestions

 

[L. Howard]

Try this, I believe the author of the code "GetPermutation(X As String, y As String)" is unknown, per MVP's of the old MS Exel Users Group.
Does the abcdefg string's 5040 Permutations in a split second.

Option Explicit
Option Compare Text
Dim CurrentRow
Sub DoString()
On Error Resume Next
    Dim Instring As String
    Dim i As Integer, j As Integer
    Instring = Range("A1").Value
        Range("A1").Select
        CurrentRow = 1
    Call GetPermutation("", Instring)
End Sub

Sub GetPermutation(X As String, y As String)
On Error Resume Next
Dim j, i
j = Len(y)
    If j < 2 Then
            Cells(CurrentRow, 1) = X & y
            CurrentRow = CurrentRow + 1
      Else
        For i = 1 To j
            Call GetPermutation(X + Mid(y, i, 1), _
            Left(y, i - 1) + Right(y, j - i))
        Next
    End If
 
End Sub

Regards,
Howard

 

[ANANKE]

thats exactly what I was looking for

thanks a lot

Try this, I believe the author of the code "GetPermutation(X As String, y As String)" is unknown, per MVP's of the old MS Exel Users Group.
Does the abcdefg string's 5040 Permutations in a split second.

Option Explicit
Option Compare Text
Dim CurrentRow
Sub DoString()
On Error Resume Next
    Dim Instring As String
    Dim i As Integer, j As Integer
    Instring = Range("A1").Value
        Range("A1").Select
        CurrentRow = 1
    Call GetPermutation("", Instring)
End Sub

Sub GetPermutation(X As String, y As String)
On Error Resume Next
Dim j, i
j = Len(y)
    If j < 2 Then
            Cells(CurrentRow, 1) = X & y
            CurrentRow = CurrentRow + 1
      Else
        For i = 1 To j
            Call GetPermutation(X + Mid(y, i, 1), _
            Left(y, i - 1) + Right(y, j - i))
        Next
    End If
 
End Sub

Regards,
Howard

 

[West Man]

I am a macro noobie. How do I copy and run this macro

 

[hiker95]

Lhoward,

Thank you very much for sharing - one for my archives - thanks.


West Man,

Sample raw data:

Excel 2007
	A
1	abcdefg
2
3
4
5
6
7
8
9
10
11
Sheet1

After the macro:

Excel 2007
	A
1	abcdefg
2	abcdegf
3	abcdfeg
4	abcdfge
5	abcdgef
5035	gfedabc
5036	gfedacb
5037	gfedbac
5038	gfedbca
5039	gfedcab
5040	gfedcba
5041
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Option Compare Text
Dim CurrentRow

Sub DoString()
'' I believe the author of the code "GetPermutation(X As String, y As String)"
''   is unknown, per MVP's of the old MS Exel Users Group.
'' Does the abcdefg string's 5040 Permutations in a split second.
On Error Resume Next
Dim Instring As String
Dim i As Integer, j As Integer
Instring = Range("A1").Value
Range("A1").Select
CurrentRow = 1
Call GetPermutation("", Instring)
End Sub

Sub GetPermutation(X As String, y As String)
On Error Resume Next
Dim j, i
j = Len(y)
If j < 2 Then
  Cells(CurrentRow, 1) = X & y
  CurrentRow = CurrentRow + 1
Else
  For i = 1 To j
    Call GetPermutation(X + Mid(y, i, 1), Left(y, i - 1) + Right(y, j - i))
  Next
End If
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the DoString macro.

 

[West Man]

Thank you, much appreciated.

 

[hiker95]

West Man,

You are very welcome. Glad I could help.

And, come back anytime.