Get all Combinations based on N

kamphai

New Member
Joined
Dec 13, 2017
Messages
3
Hello,

I need to create a macro that will give me all combinations of the listed data in sets of N. So lets say N is 2 i want 1*2 then 1*3 and and so on. I have seen a lot of looked and have seen macros similar to what i need but cant figure out how to adjust them to work for me.

ABC
11*2
21*3
31*0
02*3
2*0
3*0

<tbody>
</tbody>
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
kamphai,

Not quite sure what you want to return but the following code will mirror your table above. You can adjust the value of P (highlighted in code) for more variable combinations.

Code:
Sub Combinations()
'Ref PCG
Dim rRng As Range, p
Dim vElements, lRow As Long, vresult As Variant
 Set rRng = Range("A1", Range("A1").End(xlDown))
[B][COLOR=#ff0000]p = 2[/COLOR][/B]
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Call CombinationsNP(vElements, CInt(p), vresult, lRow, 1, 1)
End Sub
 
Sub CombinationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
Dim i As Integer
For i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    If iIndex = p Then
        lRow = lRow + 1
        Range("B" & lRow) = Join(vresult, "*")
        'Range("C" & lRow).Resize(, p) = vresult'Multi column Result
    Else
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
    End If
Next i
End Sub
 
Last edited:
Upvote 0
So i have a set range A1 to A4 which will never change and i want the results of the macro to be put into column B. The N will be in C2 which will determine how many numbers will be in the combination.

AB (result)N
12 (1*2)2
23 (1*3)
30 (1*0)
06 (2*3)
0 (2*0)
0 (3*0)

<tbody>
</tbody>
 
Upvote 0
Try:

Code:
[COLOR=#333333]Sub Combinations()[/COLOR]'Ref PCG
Dim rRng As Range, p
Dim vElements, lRow As Long, vresult As Variant
 Set rRng = Range("A1", Range("A1").End(xlDown))
[B][COLOR=#ff0000]p = Activesheet.Range("C2").Value[/COLOR][/B]
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Call CombinationsNP(vElements, CInt(p), vresult, lRow, 1, 1)
End Sub
 
Sub CombinationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
Dim i As Integer
For i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    If iIndex = p Then
        lRow = lRow + 1
        Range("B" & lRow) = Join(vresult, "*")
        'Range("C" & lRow).Resize(, p) = vresult'Multi column Result
    Else
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
    End If
Next i [COLOR=#333333]End Sub[/COLOR]
 
Upvote 0
Sorry, I misunderstood your statement. The following should do what you want.

Code:
Sub Combinations() 'Ref PCG
Dim rRng As Range, p
Dim vElements, lRow As Long, vresult As Variant
Columns("B").ClearContents
Set rRng = Range("A1", Range("A1").End(xlDown))
p = ActiveSheet.Range("C1").Value
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Call CombinationsNP(vElements, CInt(p), vresult, lRow, 1, 1)
End Sub
 
Sub CombinationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
Dim i As Integer
Dim answer As String
For i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    If iIndex = p Then
        lRow = lRow + 1
        answer = Join(vresult, "*")
        X = Split(answer, "*")
        Range("D1").Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
        Total = 1

        For Each cell In Range("D1:D" & Range("D" & Rows.Count).End(xlUp).Row)
            Total = Total * cell.Value
        Next cell
        Range("B" & lRow) = Total & " (" & answer & ")"
    Else
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
    End If
Next i

Columns("D").Delete
End Sub
 
Upvote 0
Thanks a million

I used the below and i thinks its going to work.

Sub Combinations() 'Ref PCG
Dim rRng As Range, p
Dim vElements, lRow As Long, vresult As Variant
Set rRng = Range("A1", Range("A1").End(xlDown))
p = ActiveSheet.Range("C2").Value
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Call CombinationsNP(vElements, CInt(p), vresult, lRow, 1, 1)
End Sub

Sub CombinationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
Dim i As Integer
For i = iElement To UBound(vElements)
vresult(iIndex) = vElements(i)
If iIndex = p Then
lRow = lRow + 1
Range("B" & lRow).FormulaR1C1 = "= " & Join(vresult, " * ") & ""


'Range("C" & lRow).Resize(, p) = vresult'Multi column Result

Else
Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
End If
Next i
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

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