List combinations of numbers

[tiredofit]

Assume I have four numbers in a single row, 10, 20 ,30 ,40.

I would like to list off the possible combinations, ie 4C1, 4C2, 4C3, 4C4, where C is the Excel function Combin. Mathematically nCr = n!/[(n-r)!r!]

4C1 returns 4 results, 4C2 returns 6, 4C3 returns 4 and 4C4 returns 1.

The results should be:

10
20
30
40

10,20
10,30
10,40
20,30
20,40
30,40

10,20,30
10,20,40
10,30,40
20,30,40

10,20,30,40

How can this be done in VBA?

Thanks

 

[Cubist]

Here's a formula option in 365. Let us know if you still want VBA. Try:

Book1
	A	B	C
1	10		10
2	20		20
3	30		10, 20
4	40		30
5			10, 30
6			20, 30
7			10, 20, 30
8			40
9			10, 40
10			20, 40
11			10, 20, 40
12			30, 40
13			10, 30, 40
14			20, 30, 40
15			10, 20, 30, 40
Sheet6

Cell Formulas
Range	Formula
C1:C15	C1	=DROP(MID(REDUCE(0,A1:A4,LAMBDA(a,c,VSTACK(a,a&", "&c))),4,9^9),1)
Dynamic array formulas.

 

[tiredofit]

Here's a formula option in 365. Let us know if you still want VBA. Try:

Book1
	A	B	C
1	10		10
2	20		20
3	30		10, 20
4	40		30
5			10, 30
6			20, 30
7			10, 20, 30
8			40
9			10, 40
10			20, 40
11			10, 20, 40
12			30, 40
13			10, 30, 40
14			20, 30, 40
15			10, 20, 30, 40
Sheet6

Cell Formulas
Range	Formula
C1:C15	C1	=DROP(MID(REDUCE(0,A1:A4,LAMBDA(a,c,VSTACK(a,a&", "&c))),4,9^9),1)
Dynamic array formulas.

Thanks.

Can't say I'm familiar withLAMBDA functions.

Would you have a VBA solution instead?

Just found this:

https://stackoverflow.com/questions/7198154/combination-algorithm-in-excel-vba

 

[Cubist]

Not sure if you wanted it a single string separated by commas or their cells. This is the comma-separated version.

Sub GeneratePowerSet()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim dataArr() As Variant
    Dim powerSetStrings() As String
    Dim i As Long, j As Long, k As Long
    Dim numRows As Long
    Dim outputRange As Range
    Dim outputCell As Range

    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your sheet name
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set dataRange = ws.Range("A2:A" & lastRow) 'Assumes data starts in A2
    dataArr = dataRange.Value
    numRows = UBound(dataArr, 1) - LBound(dataArr, 1) + 1
    ReDim powerSetStrings(1 To 2 ^ numRows - 1)

    For i = 1 To 2 ^ numRows - 1
        Dim subset As String
        subset = ""
        For j = 0 To numRows - 1
            If ((i And (2 ^ j)) > 0) Then
                If subset <> "" Then subset = subset & ", "
                subset = subset & dataArr(j + 1, 1)
            End If
        Next j
        powerSetStrings(i) = subset
    Next i
    
    'Output to C2
    Set outputRange = ws.Range("C2").Resize(UBound(powerSetStrings), 1)
    outputRange.Value = Application.Transpose(powerSetStrings)
    Set ws = Nothing
    Set dataRange = Nothing
    Erase dataArr
    Erase powerSetStrings
End Sub

 

[tiredofit]

Not sure if you wanted it a single string separated by commas or their cells. This is the comma-separated version.

Sub GeneratePowerSet()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim dataArr() As Variant
    Dim powerSetStrings() As String
    Dim i As Long, j As Long, k As Long
    Dim numRows As Long
    Dim outputRange As Range
    Dim outputCell As Range

    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your sheet name
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set dataRange = ws.Range("A2:A" & lastRow) 'Assumes data starts in A2
    dataArr = dataRange.Value
    numRows = UBound(dataArr, 1) - LBound(dataArr, 1) + 1
    ReDim powerSetStrings(1 To 2 ^ numRows - 1)

    For i = 1 To 2 ^ numRows - 1
        Dim subset As String
        subset = ""
        For j = 0 To numRows - 1
            If ((i And (2 ^ j)) > 0) Then
                If subset <> "" Then subset = subset & ", "
                subset = subset & dataArr(j + 1, 1)
            End If
        Next j
        powerSetStrings(i) = subset
    Next i
   
    'Output to C2
    Set outputRange = ws.Range("C2").Resize(UBound(powerSetStrings), 1)
    outputRange.Value = Application.Transpose(powerSetStrings)
    Set ws = Nothing
    Set dataRange = Nothing
    Erase dataArr
    Erase powerSetStrings
End Sub

Thanks, this'll do nicely.