stopping a number from permutating twice

When I enter a number to be permutated, the program permutates the entered number twice I.E
If I enter the number 898 the program returns 898, 988, 889, 898, 988, 889
 The program works fine when i enter a number like 123 or 1234.
will not work for a number like 1122, 1223 these type of numbers get permutated twice

Here is a copy of the program

Dim CurrentRow
Sub GetString()
    Dim InString As String
    InString = InputBox("Enter text to permute:")
    Range("a:a").ClearContents
    If Len(InString) < 2 Then Exit Sub
    If Len(S) >= 8 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
tbell000Asked:
Who is Participating?
 
Raynard7Commented:
My Option is tested and works, those provided by JackOfPh were not exactly on point.
0
 
Raynard7Commented:
Hi,

I would just dump everything into a dictionary (include the microsoft scripting runtime library) and if it exists then not repeat it then just go through and output everything in the array

ie

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

Sub GetPermutation(x As String, y As String, n As Dictionary)
    Dim i As Integer, j As Integer
    j = Len(y)
    If j < 2 Then
        If n.Exists(x & y) = False Then
            Cells(CurrentRow, 1) = x & y
            CurrentRow = CurrentRow + 1
            n.Add x & y, 1
        End If
    Else
        For i = 1 To j
            Call GetPermutation(x + Mid(y, i, 1), _
            Left(y, i - 1) + Right(y, j - i), n)
        Next
    End If
End Sub
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.