Permutation combination of a 4 digit no

  • Thread starter Thread starter amarahn
  • Start date Start date
Hi,

Try this courtesy of John Walknenbach:-

Dim CurrentRow

Sub GetString()
Dim InString As String
InString = InputBox("Enter text to permute:")
If Len(InString) < 2 Then Exit Sub
If Len(InString) >= 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)
' 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
 
Dim CurrentRow

Sub GetString()
Dim InString As String
msg = "Do You Want to Add a Sheet Y/N" & Chr(13) _
& "If No, Column A Will be Overwritten"

Ans = MsgBox(msg, vbQuestion + vbYesNoCancel)
Select Case Ans
Case vbYes
Sheets.Add
Case vbNo
GoTo carryon
Case vbCancel
Cancel = True
Exit Sub
End Select
carryon:
InString = InputBox("Enter text to permute:")
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)
' 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


Gord Dibben MS Excel MVP
 
Back
Top