I used this with a form that had a listbox that diplays all the permutations. This code does not remove dupes. (string "ABA" will return "ABA" twice) Code is not case sensitive.
this is in a bas module:
Option Explicit
Type Letters
Letter As String * 1
InUse As Boolean
End Type
Private aryLetters() As Letters
Private aryWord() As Integer
Public flgStop As Boolean
Private intLowReturn As Integer
Private intHighReturn As Integer
Private intCurrentWordSize As Integer
Private lstOutPut As ListBox
Public Sub GetWords(ByVal strWord As String, intReturnSize As Integer, ByRef lstYourList As ListBox)
Dim ctrWordSize As Integer
Dim ctrFill As Integer
Set lstOutPut = lstYourList
strWord = UCase(strWord)
ReDim aryLetters(1 To Len(strWord))
'fill letter array
For ctrFill = 1 To Len(strWord)
aryLetters(ctrFill).InUse = False
aryLetters(ctrFill).Letter = Mid(strWord, ctrFill, 1)
Next
ReDim aryWord(1 To Len(strWord))
If intReturnSize = 0 Then
intLowReturn = 1
intHighReturn = Len(strWord)
Else
intLowReturn = intReturnSize
intHighReturn = intReturnSize
End If
For ctrWordSize = intLowReturn To intHighReturn
intCurrentWordSize = ctrWordSize
MakeWords 1, Len(strWord)
Next
End Sub
Private Sub MakeWords(intIteration As Integer, intLenWord As Integer)
Dim ctrCurLetter As Integer
Dim ctrSpellWord As Integer
Dim strTemp As String
For ctrCurLetter = 1 To intLenWord
'get letter
If aryLetters(ctrCurLetter).InUse = False Then
aryLetters(ctrCurLetter).InUse = True
aryWord(intIteration) = ctrCurLetter
'see if done
If intIteration = intCurrentWordSize Then
strTemp = ""
'create word
For ctrSpellWord = 1 To intCurrentWordSize
strTemp = strTemp & aryLetters(aryWord(ctrSpellWord)).Letter
Next
'add word to list
lstOutPut.AddItem strTemp
Else
'if not go to next iteration
MakeWords intIteration + 1, intLenWord
End If
'clear current letter
aryLetters(ctrCurLetter).InUse = False
End If
Next
End Sub
called on form:
GetWords txtWord.Text, vsWordSize.Value, Me.lstWord
txtWord.Text is the string to do the permutations on.
vsWordSize.Value is the permutation length returned. If you pass a string of 5 characters and a length of 3, it will return only 3 char long perms . If a length = 0 is passed, it will return all perm. lengths from 1 to len(string).
Me.lstWord is the name of the list box.
GL & Have fun!!
Tim Tim
Remember the KISS principle:
Keep It Simple, Stupid!
