VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()

    Dim dblFactorial As Double
    Dim intLen As Integer
    Dim intColumn As Integer
    Dim intLetter As Integer
    Dim dblRepeats As Double
    Dim dblEntry As Double
    Dim dblRepFactor As Double
    Dim strCombos() As String
    Dim bIsUsed() As Boolean
    Dim strLetters As String

    strLetters = InputBox("Please enter word to scramble. " _
               & "(Keep the word short - the combinations add up quickly!)", _
                 "Word Combinations", "word")
    ' Determine the number of strLetters
    intLen = Len(strLetters)
    
    ' Calculate the number of combinations of strLetters...
    ' (For 4 strLetters that would be 4 * 3 * 2 * 1 = 24)
    dblFactorial = intLen
    Do Until intLen = 1
        intLen = intLen - 1
        dblFactorial = dblFactorial * intLen
    Loop
    
    If vbNo = MsgBox("There will be " & dblFactorial & " combinations. Continue?", _
           vbQuestion + vbYesNo) Then
        Exit Sub
    End If

    ' ...and dim the array to hold just that many
    ReDim strCombos(dblFactorial - 1)
    
    ' Restore the number of strLetters since we decremented it in the factorial calc
    intLen = Len(strLetters)
    
    ' Dimension the table that will record which strLetters have been used in
    ' which locations, so that duplicates can be avoided
    ReDim bIsUsed(dblFactorial - 1, intLen - 1)
    
    ' Set an initial value for the letter repeat factor
    dblRepFactor = dblFactorial / intLen
    
    ' Build the "columns" vertically
    For intColumn = 0 To intLen - 1
        intLetter = 1 ' When the column changes, start the strLetters over again
        For dblEntry = 0 To dblFactorial - 1
            Do While bIsUsed(dblEntry, intLetter - 1)
                 ' The pending letter is already in the combo so try the next one...
                 intLetter = intLetter + 1
                 If intLetter > intLen Then
                     ' ...but don't go "off the end" of the strLetters
                     intLetter = 1
                 End If
             Loop
            ' OK, we've got a valid entry so record it
            strCombos(dblEntry) = strCombos(dblEntry) & Mid$(strLetters, intLetter, 1)
            bIsUsed(dblEntry, intLetter - 1) = True
            ' Keep track of how many times a given letter has been repeated...
            dblRepeats = dblRepeats + 1
            If dblRepeats = dblRepFactor Then
                ' ...and when it's at its max, start over again
                dblRepeats = 0
                intLetter = intLetter + 1
                If intLetter > intLen Then
                    intLetter = 1
                End If
            End If
        Next
        ' Recalculate the repeat factor for the next "column"
        If dblRepFactor > 1 Then
            dblRepFactor = dblRepFactor / (intLen - (intColumn + 1))
        End If
    Next
    
    For dblEntry = 0 To UBound(strCombos)
        Debug.Print strCombos(dblEntry)
    Next

End Sub