• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Creating Permutations

Spiderpheonix

New Member
Hi Guys,

I have been trying to create VBA code to produce a list of all Permutations,
The below is not mine but I have amended it (Slightly)to suit my needs
Code:
Dim CurrentRow

Sub GetString()
    Dim InString As String
    InString = InputBox("Enter text to permute:")
    If Len(InString) < 2 Then Exit Sub
    If Len(InString) >= 21 Then
        MsgBox "Too many permutations!"
        Exit Sub
    Else
        ActiveSheet.Columns(1).Clear
        CurrentRow = 1
        Call GetPermutation("", InString)
    End If
End Sub

Sub GetPermutation(x As String, y As String)
    Dim i As Integer, j As Integer
    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
This does the job perfectly to a degree, However when it reaches the final row A1048576 the program ends,

1. Can you please advise as to how I can make this program continue to place results in the next column until B1048576, Then C1048576 etc. until all permutations are complete.

2. I would like to reduce the number of characters in the results also i.e if I have 10 Characters find all permutations containing 5 Characters, This is less important as I can pull these from the final results anyway.

Thanks in advance
 

Hui

Excel Ninja
Staff member
And as for the code try the following:

Code:
Dim CurrentRow As Long
Dim CurrentCol  As Integer

Sub GetString()
  Dim InString As String
  InString = InputBox("Enter text to permute:")
  If Len(InString) < 2 Then Exit Sub
  If Len(InString) >= 21 Then
    MsgBox "Too many permutations!"
    Exit Sub
  Else
    ActiveSheet.Columns(1).Clear
    CurrentRow = 1
    CurrentCol = 1
    Call GetPermutation("", InString)
  End If
End Sub

Sub GetPermutation(x As String, y As String)
  Dim i As Integer, j As Integer
  j = Len(y)
  If j < 2 Then
    Cells(CurrentRow, CurrentCol) = x & y
    'Debug.Print CurrentRow, CurrentCol, i, j, x, y
    CurrentRow = CurrentRow + 1
    If CurrentRow > 1048576 Then '1048576
      CurrentCol = CurrentCol + 1
      CurrentRow = 1
    End If
  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
 
Top