Combination and Repetition Not Allowed

[yauchildchew]

Hi, I am a very beginner in excel vba. I need to generate combinations wit
repetition
If definition is required, the site below will be the reference. SIT

For code below

CCCAAMM
MMAMCCC
et

will be generated

However, the VBA combination generator that I want to develop should onl
produce just ONE of the many repeated combinations (CCCAAMMM,MMAMCCCA,etc)

Well, to define in a better way
Say, building up combinations of 4 alphabets with {A,B,C}

Repetition of available alphabets (ABC) is allowed so that
ABCA, ABBC,AAAA..
such combinations are possible

Repetition of combinations with similar element/alphabet is not allowed, s
that
ABCA, BCAA, AABC..... (repetition is considered to have occurred
there are many of them, but in my case, I only need one, anyone of them
becaus
they will produce similar result in the later stage when i sum up values fro
each of them

The reasons of doing this is to reduce the possible combination and increas
efficiency of analysis

Sub allup(
Dim a, n As Integer, c(), k As Lon
Dim u1 As Integer, u2 As Integer, u3 As Intege
Dim u4 As Integer, u5 As Integer, u6 As Intege
Dim u7 As Integer, u8 As Integer, u9 As Intege
a = Array("C", "M", "U"
n = UBound(a) +
ReDim c(1 To Rows.Count, 1 To 9
For u1 = 1 To
For u2 = 1 To
For u3 = 1 To
For u4 = 1 To
For u5 = 1 To
For u6 = 1 To
For u7 = 1 To
For u8 = 1 To
For u9 = 1 To
k = k +
c(k, 9) = a(u9 - 1
c(k, 8) = a(u8 - 1
c(k, 7) = a(u7 - 1
c(k, 6) = a(u6 - 1
c(k, 5) = a(u5 - 1
c(k, 4) = a(u4 - 1
c(k, 3) = a(u3 - 1
c(k, 2) = a(u2 - 1
c(k, 1) = a(u1 - 1
Next u9, u8, u7, u6, u5, u4, u3, u2, u
Cells(1).Resize(k, 9) =
End Sub [/CODE

Please kindly enlighten
Thanks.

 

[James Ravenswood]

Hi, I am a very beginner in excel vba. I need to generate combinations with
 repetition.
 If definition is required, the site below will be the reference. SITE

 For code below,

 CCCAAMMM
 MMAMCCCA
 etc

 will be generated.

 However, the VBA combination generator that I want to develop should only
 produce just ONE of the many repeated combinations (CCCAAMMM,MMAMCCCA,etc).

 Well, to define in a better way.
 Say, building up combinations of 4 alphabets with {A,B,C}.

 Repetition of available alphabets (ABC) is allowed so that:
 ABCA, ABBC,AAAA...
 such combinations are possible.

 Repetition of combinations with similar element/alphabet is not allowed, so
 that:
 ABCA, BCAA, AABC..... (repetition is considered to have occurred)
 there are many of them, but in my case, I only need one, anyone of them,
because
 they will produce similar result in the later stage when i sum up values from
 each of them.

 The reasons of doing this is to reduce the possible combination and increase
 efficiency of analysis.

 

Sub allup()
 Dim a, n As Integer, c(), k As Long
 Dim u1 As Integer, u2 As Integer, u3 As Integer
 Dim u4 As Integer, u5 As Integer, u6 As Integer
 Dim u7 As Integer, u8 As Integer, u9 As Integer
 a = Array("C", "M", "U")
 n = UBound(a) + 1
 ReDim c(1 To Rows.Count, 1 To 9)
 For u1 = 1 To n
 For u2 = 1 To n
 For u3 = 1 To n
 For u4 = 1 To n
 For u5 = 1 To n
 For u6 = 1 To n
 For u7 = 1 To n
 For u8 = 1 To n
 For u9 = 1 To n
 k = k + 1
 c(k, 9) = a(u9 - 1)
 c(k, 8) = a(u8 - 1)
 c(k, 7) = a(u7 - 1)
 c(k, 6) = a(u6 - 1)
 c(k, 5) = a(u5 - 1)
 c(k, 4) = a(u4 - 1)
 c(k, 3) = a(u3 - 1)
 c(k, 2) = a(u2 - 1)
 c(k, 1) = a(u1 - 1)
 Next u9, u8, u7, u6, u5, u4, u3, u2, u1
 Cells(1).Resize(k, 9) = c
 End Sub

 Please kindly enlighten.
 Thanks.

This is based on:
http://groups.google.com/group/micr...&q=sort+characters+in+string#4b63f96d9244c2ed

The technique is to generate ALL the combinations and then identify
and discard "repeats"

Sub BuildCombinations()
leters = Array("A", "B", "C", "D")
m = 2
For i = 0 To 3
For j = 0 To 3
For k = 0 To 3
For l = 0 To 3
Cells(m, "A").Value = leters(i) & leters(j) & leters(k) & leters(l)
m = m + 1
Next
Next
Next
Next
End Sub

This macro puts the 256 combination in column A

In B2, enter:

=internalsort(A2) and copy down

Where:

Public Function InternalSort(r As Range) As String
Dim v As String
v = r.Value
For i = 1 To (Len(v) - 1)
For j = (i + 1) To Len(v)
char_i = Mid(v, i, 1)
char_j = Mid(v, j, 1)
If Asc(char_i) > Asc(char_j) Then
Mid(v, i, 1) = char_j
Mid(v, j, 1) = char_i
End If
Next j
Next i
InternalSort = v
End Function

This UDF just sorts the characters in the column A cells

In C2, enter:

=COUNTIF(B2:B$2,B2)

In A2 thru C20 we now see:

AAAA AAAA 1
AAAB AAAB 1
AAAC AAAC 1
AAAD AAAD 1
AABA AAAB 2
AABB AABB 1
AABC AABC 1
AABD AABD 1
AACA AAAC 2
AACB AABC 2
AACC AACC 1
AACD AACD 1
AADA AAAD 2
AADB AABD 2
AADC AACD 2
AADD AADD 1
ABAA AAAB 3
ABAB AABB 2
ABAC AABC 3

The first 2 in column C says that AABA is really the "same as" AAAB
If we AutoFilter column C and pick only the 1's, we have what you want.