' in normal module
Dim Choosing() As clsChoice, partitionCount As Long: Rem zero based
Dim arrAlphabet As Variant, alphaCount As Long: Rem one based
Const strPipe As String = "|"
Const Delimiter As String = "+"
Sub MixedStuff()
Dim strPattern As String
Dim i As Long, strAlphabet As String
Dim subPatterns As Variant, baseParts As Variant
Dim xVal As Variant
Dim oneChoice As clsChoice
Dim strTest As String, lookMoreFlag As Boolean, oneSub As Variant
Dim ovFlag As Boolean
Dim Destinationsheet As Worksheet
Dim onePerm As clsPermuation, strOut As String, arrOut As Variant
Set Destinationsheet = Sheet1
strAlphabet = "ABCDE"
strPattern = "x+x|x|x"
alphaCount = Len(strAlphabet)
ReDim arrAlphabet(1 To alphaCount)
For i = 1 To alphaCount
arrAlphabet(i) = Mid(strAlphabet, i, 1)
Next i
subPatterns = Split(strPattern, strPipe)
partitionCount = UBound(subPatterns) + 1
ReDim Choosing(0 To partitionCount - 1)
For i = 0 To partitionCount - 1
Set oneChoice = New clsChoice
xVal = Split(subPatterns(i), Delimiter)
oneChoice.FromN(UBound(xVal) + 1) = alphaCount
Set Choosing(i) = oneChoice
Next i
Set oneChoice = Nothing
Destinationsheet.Cells.ClearContents
Do
Do
Call NextPartition(ovFlag)
If ovFlag Then Exit Do
strTest = CurrentPartition(baseParts)
strTest = strPipe & Replace(strTest, Delimiter, strPipe) & strPipe
lookMoreFlag = False
For Each oneSub In Split(strTest, strPipe)
If Len(strTest) - Len(Replace(strTest, oneSub, vbNullString)) > Len(oneSub) Then
lookMoreFlag = True
End If
Next oneSub
Loop While lookMoreFlag
If Not ovFlag Then
If IsError(Application.Match(CurrentPartition, Destinationsheet.Range("A:A"), 0)) Then
' output this partition
Set onePerm = New clsPermuation
Do
arrOut = onePerm.ActingOn(baseParts)
strOut = vbNullString
For i = LBound(arrOut) To UBound(arrOut)
strOut = strOut & strPipe & arrOut(i)
Next i
strOut = Mid(strOut, Len(strPipe) + 1)
Destinationsheet.Range("A65536").End(xlUp).Offset(1, 0).Value = strOut
Set onePerm = onePerm.NextPermutation
Loop Until partitionCount < onePerm.Level
End If
End If
Loop Until ovFlag
Set onePerm = Nothing
Set oneChoice = Nothing
End Sub
Sub NextPartition(Optional ByRef blnReturn As Boolean)
Dim lookAt As Long
Dim oVal As Boolean
lookAt = partitionCount - 1
Do
Set Choosing(lookAt) = Choosing(lookAt).NextChoice(oVal)
lookAt = lookAt - 1: If lookAt < 0 Then Exit Do
Loop While oVal
blnReturn = oVal And (lookAt < 0)
End Sub
Function CurrentPartition(Optional ByRef Subs As Variant) As String
Dim i As Long, j As Long
Dim subPartitions() As String
ReDim subPartitions(0 To partitionCount - 1)
For i = 0 To partitionCount - 1
For j = 1 To alphaCount
If Choosing(i).ChoiceArray(j) Then
subPartitions(i) = subPartitions(i) & Delimiter & arrAlphabet(j)
End If
Next j
subPartitions(i) = Mid(subPartitions(i), Len(Delimiter) + 1)
Next i
Subs = subPartitions
CurrentPartition = Join(subPartitions, strPipe)
End Function