Power Set of a Set

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
Office Version
  1. 2010
Hello, I found code below under the link shown which is written by pcg01 and it is quite close to my requirement does code could be modified as describe…

http://www.mrexcel.com/forum/excel-...ns-combinations-permutations.html#post2152567

Original Code By pcg01: Calculate the Power Set of a Set
Code: 
Option Explicit
 
' PGC Oct 2007
' Calculates a Power Set
' Set in A1, down. Result in C1, down and accross. Clears C:Z.
Sub PowerSet()
Dim vElements As Variant, vresult As Variant
Dim lRow As Long, i As Long
 
vElements = Application.Transpose(Range("A1", Range("A1").End(xlDown)))
Columns("C:Z").Clear
 
lRow = 1
For i = 1 To UBound(vElements)
    ReDim vresult(1 To i)
    Call CombinationsNP(vElements, i, vresult, lRow, 1, 1)
Next i
End Sub
 
Sub CombinationsNP(vElements As Variant, p As Long, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
Dim i As Long
 
For i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    If iIndex = p Then
        lRow = lRow + 1
        Range("C" & lRow).Resize(, p) = vresult
    Else
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
    End If
Next i
End Sub

- Write a, b, c, d in A1:A4
- run PowerSet


Book1
ABCDEFGHIJKLMNOP
11
2171
32217
43322
54433
644
7117
8122
9133
10144
111722
121733
131744
142233
152244
163344
1711722
1811733
1911744
2012233
2112244
2213344
23172233
24172244
25173344
26223344
271172233
281172244
291173344
301223344
3117223344
32117223344
pgc01 Set-Up


Now assume numbers are in column A 1-17-22-33-44
Num1 stand in Position1
Num17 stand in Position2
Num22 stand in Position3
Num33 stand in Position4
Num44 stand in Position5

What I need:
Num1 goes in to column C
Num17 goes in to column D
Num22 goes in to column E
Num33 goes in to column F
Num44 goes in to column G

I will use max 14-numbers so 14-position column C to P

In Column Q I want sum of the each row

My Example:


Book1
ABCDEFGHIJKLMNOPQ
11P1P2P3P4P5P6P7P8P9P10P11P12P13P14Sum
21711
3221717
4332222
5443333
64444
711718
812223
91334478
1014445
11172239
12173350
13174461
14223355
15224466
16334477
171172240
181173351
191174462
201223356
211224467
221334478
2317223372
2417224483
2517334494
2622334499
27117223373
28117224484
29117334495
301223344100
3117223344116
32117223344117
Require


Thank you in advance

Regards,
Moti
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
Hello, may be it is easy for programmer to generate a new code instead modifying the old one. Please any one can help to create a new one.

Thank you

Regards,
Moti
 
Upvote 0
Try pgc's modified code:-

Code: 
[COLOR="Navy"]Sub[/COLOR] PowerSet()
[COLOR="Navy"]Dim[/COLOR] vElements [COLOR="Navy"]As[/COLOR] Variant, vresult [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] lRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
vElements = Application.Transpose(Range("A1", Range("A1").End(xlDown)))
Columns("C:Z").Clear
'[COLOR="Green"][B]#########[/B][/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(vElements)
Dic(vElements(n)) = n + 2
[COLOR="Navy"]Next[/COLOR]
'[COLOR="Green"][B]############[/B][/COLOR]
lRow = 1
[COLOR="Navy"]For[/COLOR] i = 1 To UBound(vElements)
    ReDim vresult(1 To i)
    Call CombinationsNP(vElements, i, vresult, lRow, 1, 1, Dic)
[COLOR="Navy"]Next[/COLOR] i
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
 
[COLOR="Navy"]Sub[/COLOR] CombinationsNP(vElements [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] vresult [COLOR="Navy"]As[/COLOR] Variant, lRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] iElement [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] iIndex [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object)
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] V [COLOR="Navy"]As[/COLOR] Variant
 
[COLOR="Navy"]For[/COLOR] i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    [COLOR="Navy"]If[/COLOR] iIndex = p [COLOR="Navy"]Then[/COLOR]
        lRow = lRow + 1
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] V [COLOR="Navy"]In[/COLOR] vresult
            Cells(lRow, Dic(V)) = V
            Cells(lRow, "Q") = Application.Sum(Cells(lRow, 3).Resize(, UBound(vElements)). _
            SpecialCells(xlCellTypeConstants))
       [COLOR="Navy"]Next[/COLOR] V
        '[COLOR="Green"][B]Range("C" & lRow).Resize(, p) = vresult[/B][/COLOR]
    [COLOR="Navy"]Else[/COLOR]
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1, Dic)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] i
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try pgc's modified code:-

Code: 
[COLOR=Navy]Sub[/COLOR] PowerSet()
[COLOR=Navy]Dim[/COLOR] vElements [COLOR=Navy]As[/COLOR] Variant, vresult [COLOR=Navy]As[/COLOR] Variant, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] lRow [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] i [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object
vElements = Application.Transpose(Range("A1", Range("A1").End(xlDown)))
Columns("C:Z").Clear
'[COLOR=Green][B]#########[/B][/COLOR]
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] n = 1 To UBound(vElements)
Dic(vElements(n)) = n + 2
[COLOR=Navy]Next[/COLOR]
'[COLOR=Green][B]############[/B][/COLOR]
lRow = 1
[COLOR=Navy]For[/COLOR] i = 1 To UBound(vElements)
    ReDim vresult(1 To i)
    Call CombinationsNP(vElements, i, vresult, lRow, 1, 1, Dic)
[COLOR=Navy]Next[/COLOR] i
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
 
[COLOR=Navy]Sub[/COLOR] CombinationsNP(vElements [COLOR=Navy]As[/COLOR] Variant, p [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] vresult [COLOR=Navy]As[/COLOR] Variant, lRow [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] iElement [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] iIndex [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object)
[COLOR=Navy]Dim[/COLOR] i [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] V [COLOR=Navy]As[/COLOR] Variant
 
[COLOR=Navy]For[/COLOR] i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    [COLOR=Navy]If[/COLOR] iIndex = p [COLOR=Navy]Then[/COLOR]
        lRow = lRow + 1
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] V [COLOR=Navy]In[/COLOR] vresult
            Cells(lRow, Dic(V)) = V
            Cells(lRow, "Q") = Application.Sum(Cells(lRow, 3).Resize(, UBound(vElements)). _
            SpecialCells(xlCellTypeConstants))
       [COLOR=Navy]Next[/COLOR] V
        '[COLOR=Green][B]Range("C" & lRow).Resize(, p) = vresult[/B][/COLOR]
    [COLOR=Navy]Else[/COLOR]
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1, Dic)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] i
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

MickG, speechless result 100% OK

I appreciate a lot your cooperation.

Kind Regards,
Moti
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Locked
  • Question Question
VBA code to list all permutation of N distinct objects of size r without repetition
Replies
6
Views
896
Fluff
Fluff
C
  • Solved
VBA code to list all permutation of N distinct objects of size r without repetition
2
Replies
15
Views
2K
Chyke_mxl
C
P
  • Question Question
putting a snippet of code from one to another somehow
Replies
5
Views
298
Patriot2879
P
montecarlo2012
  • Question Question
[VBA&code] Adding controls to an existing code.
Replies
1
Views
401
montecarlo2012
montecarlo2012
M
  • Question Question
Grouped Unique Combinations Generator
Replies
9
Views
3K
EXCEL MAX
EXCEL MAX

Forum statistics

Threads
1,223,275
Messages
6,171,122
Members
452,381
Latest member
Nova88

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