permutations - sub sets

M

mountainclimber11

Board Regular
Joined
Dec 1, 2009
Messages
79
Hello,

I can do permutations via this code:
http://codeguru.earthweb.com/forum/showthread.php?t=301647
Post # 9 is most like what I'm looking for, except instead of going from this:
a
b
c
And getting this:
<TABLE style="WIDTH: 48pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=64><COLGROUP><COL style="WIDTH: 48pt" width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20 width=64>a</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>b</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>c</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>a</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>c</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>b</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>b</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>a</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>c</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>b</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>c</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>a</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>c</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>b</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>a</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20></TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>c</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>a</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>b</TD></TR></TBODY></TABLE>
I want this before it:
a

b

c

a
b

a
c

b
a

b
c

c
a

c
b

(then permutations with 3 as the referenced code already does...)

Can anyone point to some code that does this for an unknown number of words? I've looked on line for a while and have only found variations of what I have already found. I can modify the code if its not exactly what I need...for example I'm actually going to feed strings in as an array of strings and return the permutations I want in a big array of strings. Thanks!
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
Is this something like what you want?
Code: 
Sub comboze()
Dim z, y() As String, u As Integer, v As Integer
Dim a As Integer, b As Long, c As Integer, d As Integer
Dim w(), g, ct, i, j, kk
z = Array("a", "b", "c")
u = UBound(z) + 1
v = u
ReDim y(1 To u ^ v, 1 To v), w(1 To u ^ v, 1 To v)
For a = 1 To v
    For b = 1 To u ^ v Step u ^ a
        For c = b To b + u ^ (a - 1) - 1
            For d = 1 To u
                y(c + u ^ (a - 1) * (d - 1), v - a + 1) = z(d - 1)
Next d, c, b, a
n = u ^ v: m = v
With CreateObject("Scripting.Dictionary")
    For i = 1 To n
        For j = 1 To m
            .Item(y(i, j)) = .Item(y(i, j)) + 1
        Next j
        kk = .keys
        For a = 1 To .Count
            w(i, a) = kk(a - 1)
        Next a
        .removeall
    Next i
For i = 1 To n
    g = Empty
    For j = 1 To m: g = g & Chr(30) & w(i, j): Next j
    If Not .exists(g) Then
        .Add g, Empty
        ct = ct + 1
        For j = 1 To m: w(ct, j) = w(i, j): Next j
    End If
Next i
End With
Range("A1").Resize(ct, m) = w
End Sub
 
Upvote 0
Hello,
The permutations code above is working great! Thanks again...

Another part of my code requires the exact same thing except combinations. So array of strings in, array of strings out. With the same info except order doesn't matter this times (combos only):

array in:
a
b
c

array out:
a
b
c
ab
ac
bc
abc
...and thats it.

If you have something that would be awesome, otherwise I'll have to modify some of the others I've seen to take an array and return an array.

Thanks!
 
Upvote 0
I did it. Not sure its the most efficient, but it looks like it works after a little testing.

So it takes an array and returns a two dimensional array with all combinations (not permutations). Like this: abc will result in: a, b, c, ab, ac, bc, abc.

(I hacked up a few things I found on this and other forums to get it to work...its ugly but I think it works.)

Code: 
Function PowerSet(myArray() As Variant) As Variant()
Dim vresult As Variant
Dim lRow As Long, i As Long
Dim vElements() As Variant
vElements = myArray
Dim ub As Long
Dim z As Long
Dim inc As Long
Dim combs As Long
ub = UBound(vElements)
inc = 0
combs = 0
For z = 1 To ub
    inc = Factorial(ub) / (Factorial(z) * Factorial(ub - z))
    combs = combs + inc
Next z
'MsgBox combs
ReDim v2dTemp(1 To combs, 1 To UBound(vElements)) As Variant
lRow = 1
For i = 1 To UBound(vElements)
    ReDim vresult(1 To i)
    
    v2dTemp = CombinationsNP(v2dTemp, vElements, i, vresult, lRow, 1, 1)
Next i
PowerSet = v2dTemp
End Function
 
Function CombinationsNP(v2dTemp() As Variant, vElements As Variant, p As Long, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer) As Variant()
Dim i As Long
For i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    If iIndex = p Then
    
    For x = 1 To UBound(vresult)
        v2dTemp(lRow, x) = vresult(x)
        
    Next x
    
    lRow = lRow + 1
    
    Else
    
        Call CombinationsNP(v2dTemp, vElements, p, vresult, lRow, i + 1, iIndex + 1)
    End If
Next i
CombinationsNP = v2dTemp
End Function

Function Factorial(n As Long) As Double
' Function with loop to calculate a factorial
Factorial = 1
For i = 1 To n
Factorial = Factorial * i
  Next i
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
575
smozgur
smozgur
Q
  • Solved
VBA: Dynamically Create Active X Frame and Yes / No Radio Button
2
Replies
13
Views
195
Domenic
D
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
O
  • Solved
VBA - floating photo
Replies
3
Views
342
RoryA
RoryA
E
  • Question Question
VBA code clean up
Replies
9
Views
538
mumps
mumps

Forum statistics

Threads
1,223,992
Messages
6,175,822
Members
452,672
Latest member
missbanana

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top