Solved

# Function to rumble letters

Posted on 2006-07-06
1,262 Views
Hi! I need a function that will rumble the possible combination of the letters.

for example... I have the letters a, b, c and d. I want it o rumble all the possible combinations< no repition of letters>.

the above string should produce...

abcd
abdc

so on and so forth

thanks
0
Question by:JackOfPH
1 Comment

LVL 17

Accepted Solution

inthedark earned 200 total points
ID: 17049153
have worked a lot with finite resource allocation I decided to create a class which makes this task easy. The following class will do what you need....see example 2 if you want to work with alphabetic keys.

In some situations, with longer keys, you may want to work with numerics.

01234
01243
etc.

The class will either return a key or an array of numerics.

Simple to use works just like a recordset.

But depending on that task at hand there may be more efficient ways of solving your particular problem. Knowing all of the permutations is not exactly a solution so a real life problem. But this will answer your question.

Hope this helps :~)

-------------------------zPermutations.cls
Option Explicit

' Class: zPermutations
' Author: Nick Young nyoung@vipintersoft.com
' Copyright (c) 2003 Nick Young
' You may use & distribute freely but provided that the author and copyright are acknowledged.

' WARNING: Read The Notes for the item property

'' example 1 using numeric keys
'Dim Px As zPermutations
'Set Px = New zPermutations
'Px.Elements = 3
'Px.Numeric = True
'Px.MoveFirst
'Do While Not Px.EOF
'    Debug.Print Px.CurrentKey
'    Px.MoveNext
'Loop
'Stop
'
'' example 2 using aplha keys
'Set Px = New zPermutations
'Px.Elements = 3
'Px.Numeric = False
'Px.MoveFirst
'Do While Not Px.EOF
'    Debug.Print Px.CurrentKey
'    Px.MoveNext
'Loop
'Stop
'
'' Example 3 using array of values
'Set Px = New zPermutations
'Px.Elements = 3
'Px.Numeric = True
'Px.ArrayBase = 0 ' set
'
'Px.MoveFirst
'
'Dim CurrentKey() As Long
'Dim lc As Long
'
'Do While Not Px.EOF
'    For lc = LBound(CurrentKey) To UBound(CurrentKey)
'        Debug.Print CStr(CurrentKey(lc)); " ";
'    Next lc
'    Debug.Print
'    Px.MoveNext
'Loop
'Stop

Dim mlElements As Long

Dim B() As Boolean
Dim Sequence() As Long

Dim mbComplete As Boolean
Dim mlCurrent As Long

Public ElementsFound As Long

Public Numeric As Boolean

Dim mlKeyCount
Dim mvKeys() As Variant

Dim mlArrayBase As Long

' adds a key value for the next element

mlKeyCount = mlKeyCount + 1
ReDim Preserve mvKeys(mlKeyCount - 1)
mvKeys(mlKeyCount - 1) = Key

End Function

Public Property Let ArrayBase(plNewValue As Long)
mlArrayBase = plNewValue
End Property

Public Function Char(Item) As String
' converts a binary value into a letter
' so zero is A, 1 is B etc.
Char = Chr(Item + 65)
End Function

Public Function CurrentKey() As String

' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.

If Numeric Then
Dim sKey As String
Dim lc As Long

sKey = Space(mlElements + 1)

For lc = 0 To mlElements
Mid(sKey, lc + 1, 1) = Chr(48 + mvKeys(Sequence(lc)))
Next lc
CurrentKey = sKey
Else

sKey = ""

For lc = 0 To mlElements
sKey = sKey & mvKeys(Sequence(lc))
Next lc
CurrentKey = sKey
End If

End Function

' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.
Static bDone As Boolean
If Not bDone Then
bDone = True
ReDim rLongArray(mlArrayBase To mlArrayBase + mlElements)
End If

Dim sKey As String
Dim lc As Long

sKey = ""

For lc = 0 To mlElements
rLongArray(lc + mlArrayBase) = mvKeys(Sequence(lc))
Next lc

End Sub
Public Function EOF() As Boolean

' returns true if all possibles been found?

EOF = mbComplete
End Function
Public Property Get Item(Element) As Variant

' ** WARNING: READ THESE NOTES:
' make this the default proeprty
' Select Tools, Provedure attributes, select the Item propery,
' then Advanced, change the procedure ID to Default,
' then click APPLY

' this will return the key value for an element
' or if no keys were specified it will return
' the numeric value of the sequence

If mlKeyCount > 0 Then
Item = mvKeys(Sequence(Element))
Else
Item = Sequence(Element)
End If

End Property

Public Property Get Value(Element) As Long

' this will return the numeric value for an element

Value = Sequence(Element)

End Property

Public Sub MoveFirst()

' move to the start of the sequence

ReDim B(mlElements)
ReDim Sequence(mlElements)

Dim lc As Long

' SET UP LOWEST POSSIBLE VALUE
For lc = 0 To mlElements
Sequence(lc) = lc
Next

' setup starting point for next move
mlCurrent = mlElements
ElementsFound = 1
mbComplete = False

End Sub

Public Sub MoveNext()

' setup key values for the next item

Dim bInvalid As Boolean
Dim lc As Long
Dim lVal As Long

' keep looping until the next valid permutation is found

' example 42345 is invalid so add 1
' butthe thing that makes this routine fast
' is that it knows that the 2nd 4 is repeated and must be changed next

Do

If mbComplete Then Exit Sub

' now see if the current sequence is a valid permutation

' clear an incidator so see if a value has been found
For lc = 0 To mlElements
B(lc) = False
Next

bInvalid = False

For lc = 0 To mlElements
lVal = Sequence(lc)
If B(lVal) Then
bInvalid = True
Exit For
Else
B(lVal) = True
End If
Next

If Not bInvalid Then
' make sure next advance will work on the last change
mlCurrent = mlElements
Exit Do
End If

Loop

ElementsFound = ElementsFound + 1

End Sub

' to see what this functions does is imagine you
' are working in base 10 and you have the number
' 12349
' add 1 to this number and you get 12350
' this function does the same but in the specified base

' ABC
' ACA
' ACB

Do
' add 1 to the last returned sequence
Sequence(mlCurrent) = Sequence(mlCurrent) + 1
If Sequence(mlCurrent) <= mlElements Then
mlCurrent = mlElements
' Form1.List1.AddItem "N: " + CurrentKey
Exit Sub
End If
Sequence(mlCurrent) = 0
mlCurrent = mlCurrent - 1
If mlCurrent < 0 Then
mbComplete = True
Exit Sub
End If
Loop

End Sub
Public Property Get Elements() As Long

' returns the number of elements

Elements = mlElements + 1

End Property

Public Property Let Elements(NewValue As Long)

' Sets the number of elements to be used

' example value passed as 5
' is elements 0 to 4 so the number 4 is stored

' but don't allow less than 2 elements
If NewValue < 2 Then
mlElements = 1
Else
mlElements = NewValue - 1
End If

ReDim mvKeys(mlElements)
Dim lc As Long
For lc = 0 To mlElements
mvKeys(lc) = Chr(65 + lc)
Next lc
mlKeyCount = 0

MoveFirst

End Property

Public Property Get Permutations() As Double

' calculate the possibilities

Dim P As Double
Dim lc As Double

P = 1
For lc = mlElements + 1 To 2 Step -1
P = P * lc
Next

Permutations = P

End Property

Private Sub Class_Initialize()
mlArrayBase = 0
End Sub

0

## Featured Post

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…