Generate all possible combinations between 3 letters

Hi rcprito,

Try the following code:

Option Explicit

Dim wsGblOutput As Worksheet
Dim iGblOutputRow As Long

Private Sub CommandButton1_Click()

    Dim Letters As String
    
    'Clear the output Area
    Range("A1", Columns("A").SpecialCells(xlCellTypeLastCell)).Delete
    
    'Create the Source String for Permulations
    Letters = "abc"
    
    'Initialize Global variables
    Set wsGblOutput = ActiveSheet
    iGblOutputRow = 1
    
    'Generate Permutations of the 'Source String' and
    'Output results in Column 'A' of the Output Worksheet
    Call GetPermutationsOfString("", Letters)
    
    'Clear object pointers
    Set wsGblOutput = Nothing
            
End Sub
 
Sub GetPermutationsOfString(x As String, y As String)
  'Reference: http://spreadsheetpage.com/index.php/tip/generating_permutations/
  '
  'Usage:  GetPermutationsOfString("", sOriginalString)
  '
  'Number of Permuations for Original String Length:
  ' 1            1
  ' 2            2
  ' 3            6
  ' 4           24
  ' 5          120
  ' 6          720
  ' 7        5,040
  ' 8       40,320
  ' 9      362,880
  '10    3,628,800
  '11   39,916,800
  '12  479,001,600
  
  '
  'For Excel 2003  the Maximum original string length is 8 (generates  40,328 rows - Excel Max rows =    65,536)
  'For Excel 2007+ the Maximum original string length is 9 (generates 363,880 rows - Excel Max rows = 1,048,576)
  
  Dim i As Integer
  Dim j As Integer
  
  j = Len(y)
  If j < 2 Then
    wsGblOutput.Cells(iGblOutputRow, 1) = x & y
    iGblOutputRow = iGblOutputRow + 1
  Else
    For i = 1 To j
      Call GetPermutationsOfString(x + Mid(y, i, 1), Left(y, i - 1) + Right(y, j - i))
    Next
  End If
  
End Sub

Lewis

The file would be over 5000 MB. What would you do with it if you had it?

From the programme above, how from 10 letters can we write all the possible words with 3 of these letters?

See the following code, which outputs the results in Column 'A' and Column 'B' of the Active Sheet:

Option Explicit

Dim wsGblOutput As Worksheet
Dim iGblOutputRow As Long

Sub GeneratePermutationsFromCombinationsTakenNatOneTime()
  'This generates a list of permutations from Combinations taken 3 at a time from an original string
  
  Const nThreeItemsAtOneTIME = 3
  
  Dim i As Long
  Dim sReturnArray() As String
  Dim sOriginalString As String
  
  'Create the Source String for Combinations and Permulations
  sOriginalString = "abcdefghij"
  
  'Initialize the Output resources
  Set wsGblOutput = ActiveSheet
  iGblOutputRow = 1
  
  'Clear the output Area
  wsGblOutput.Range("A1:B" & rows.Count).ClearContents
    
  'Create an array of Combinations of the original string taken N at one time
  sReturnArray = GenerateCombinationsTakenNatOneTime(sOriginalString, nThreeItemsAtOneTIME)
  
  'Create Permutations from each Combination
  For i = LBound(sReturnArray) To UBound(sReturnArray)
    'Generate Permutations of the 'Source String' and
    'Output results in Column 'A' of the Output Worksheet
    wsGblOutput.Cells(iGblOutputRow, "A") = sReturnArray(i)
    Call GetPermutationsOfString("", sReturnArray(i))
  Next i
  
  'Clear object pointers
  Set wsGblOutput = Nothing
  
End Sub

 
Sub GetPermutationsOfString(x As String, y As String)
  'Reference: http://spreadsheetpage.com/index.php/tip/generating_permutations/
  '
  'Usage:  GetPermutationsOfString("", sOriginalString)
  '
  'Number of Permuations for Original String Length:
  ' 1            1
  ' 2            2
  ' 3            6
  ' 4           24
  ' 5          120
  ' 6          720
  ' 7        5,040
  ' 8       40,320
  ' 9      362,880
  '10    3,628,800
  '11   39,916,800
  '12  479,001,600
  
  '
  'For Excel 2003  the Maximum original string length is 8 (generates  40,328 rows - Excel Max rows =    65,536)
  'For Excel 2007+ the Maximum original string length is 9 (generates 363,880 rows - Excel Max rows = 1,048,576)
  
  Dim i As Integer
  Dim j As Integer
  
  j = Len(y)
  If j < 2 Then
    wsGblOutput.Cells(iGblOutputRow, "B") = x & y
    iGblOutputRow = iGblOutputRow + 1
  Else
    For i = 1 To j
      Call GetPermutationsOfString(x + Mid(y, i, 1), Left(y, i - 1) + Right(y, j - i))
    Next
  End If
  
End Sub


Function GenerateCombinationsTakenNatOneTime(sOriginalString As String, n As Long) As Variant
  'This returns an array of combinations taken N at one time from an 'Original String'

  Dim vElements As Variant
  Dim vResult As Variant
  Dim sReturnArray() As String
  Dim lRow As Long
  Dim i As Long
  Dim iLastIndex As Integer
  
  'Put  'Original String'
  iLastIndex = Len(sOriginalString)
  ReDim vElements(1 To iLastIndex)
    
  'Divide the 'Original String' into an array of Characters
  For i = 1 To iLastIndex
    vElements(i) = Mid(sOriginalString, i, 1)
  Next i
    
  'Generate an array of Combinations taken N at one time
  lRow = 0
  ReDim vResult(1 To iLastIndex)
  Call CombinationsNP(vElements, n, vResult, lRow, 1, 1, sReturnArray)
  
  'Return the Result Array to the calling routine
  GenerateCombinationsTakenNatOneTime = sReturnArray

End Function

 
Sub CombinationsNP(ByVal vElements As Variant, _
                   ByVal p As Long, _
                   ByRef vResult As Variant, _
                   ByRef lRow As Long, _
                   ByVal iElement As Integer, _
                   ByVal iIndex As Integer, _
                   ByRef sReturnArray() As String)
  'This generates a list of combinations of a string taken n at one time in sReturnArray()
  '
  '
  'Reference: http://www.rpbridge.net/7z78.htm     'Table of Factorials and Combinations
  'Tutorial: http://www.stat.wisc.edu/~ifischer/Intro_Stat/Lecture_Notes/APPENDIX/A1._Basic_Reviews/A1.2_-_Perms_and_Combos.pdf
                   

  Dim i As Long
  Dim ii As Long
  Dim sValue As String
 
  For i = iElement To UBound(vElements)
    vResult(iIndex) = vElements(i)
    If iIndex = p Then
      lRow = lRow + 1
    
      'Result is here
      sValue = ""
      For ii = LBound(vResult) To UBound(vResult)
        sValue = sValue & vResult(ii)
      Next ii
      ReDim Preserve sReturnArray(1 To lRow)
      sReturnArray(lRow) = sValue
    
    Else
        Call CombinationsNP(vElements, p, vResult, lRow, i + 1, iIndex + 1, sReturnArray)
    
    End If
  Next i
  
End Sub

Lewis