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

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
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

A
  • Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
1K
Attrazion
A
R
  • Question
Macro not working after adding two new items
Replies
4
Views
108
myall_blues
myall_blues
G
  • Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
834
gvsumich
G
D
  • Solved
Shapes.AddPicture into cell
Replies
7
Views
279
dimitrilouwet
D
D
  • Question
Problems Encountered When Generating VBA Excel Charts with 15-Minute Interval Data.
Replies
0
Views
158
dilshod_k
D

Forum statistics

Threads
1,214,990
Messages
6,122,626
Members
449,094
Latest member
bsb1122

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