Generate permutations but delete double entries

  • Thread starter Thread starter as_sass
  • Start date Start date
A

as_sass

Hi all,

Some time ago I got a macro from this forum that generates permutations
from a string of numbers (see code below).

The problem is that the macro will only do this for strings <= 8 digits
long, as it pastes the permutations in a column and then hits the
maximum number of rows it can fill.

Is there a way to

a) make the macro not generate double entries (i.e., when I ask for the
permutations for '121', this macro returns 121 and 121...)

b) make the macro print out the permutations as a text file, rather
than paste it into excel? Alternatively, maybe start a new column once
the max number of rows is reached?)

Your help, as always, is greatly appreciated.

sass

Dim CurrentRow

Sub GetString()
Dim InString As String
InString = Sheets("Sheet1").Range("B1")
ActiveSheet.Columns(1).Clear
CurrentRow = 1
Call GetPermutation("", InString)
End Sub

Sub GetPermutation(x As String, y As String)
' The source of this algorithm is unknown
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
 
Sub GetString()
Dim InString As String, Dim ff as Long
InString = Sheets("Sheet1").Range("B1")
ActiveSheet.Columns(1).Clear
CurrentRow = 1
ff = freefile
Open "C:\Myfiles\MyPerms.txt" for Output as #ff
Call GetPermutation("", InString,ff)
Close #ff
End Sub

Sub GetPermutation(x As String, y As String, ff as Long)
' The source of this algorithm is unknown
Dim i As Integer, j As Integer
j = Len(y)
If j < 2 Then
'Cells(CurrentRow, 1) = x & y
Print #ff, 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

The way this operates really doesn't look at the values in the string, so
you would have to store all the values generated and not write out the value
if it matches something already used. You could do this with a dictionary
object or collection object.

See an example of this approach using a collection at J-walks site (where
you probably got the permutation code originally)

http://www.j-walk.com/ss/excel/tips/tip47.htm
 
Tom,

Thanks for the prompt reply!

I think I know how it is supposed to work, but I get the following
error message:

Compile Error: Argument not optional.

In the code of of GetPermutation(), the following line gets
highlighted:

Call GetPermutation(x + Mid(y, i, 1), _

Any ideas?

Thanks,

sass
 
Change this:

Call GetPermutation(x + Mid(y, i, 1), _
Left(y, i - 1) + Right(y, j - i))

to:

Call GetPermutation(x + Mid(y, i, 1), _
Left(y, i - 1) + Right(y, j - i), ff)
 
Back
Top