Get all Combinations based on N

[kamphai]

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.

[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]1*2[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1*3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]1*0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]0[/TD]
[TD]2*3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2*0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3*0[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[D3allamerican07]

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.

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

 

[kamphai]

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.

[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B (result)[/TD]
[TD]N[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2 (1*2)[/TD]
[TD]2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]3 (1*3)[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]0 (1*0)[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]0[/TD]
[TD]6 (2*3)[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]0 (2*0)[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]0 (3*0)[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[D3allamerican07]

Try:

[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]

 

[D3allamerican07]

Sorry, I misunderstood your statement. The following should do what you want.

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

 

[kamphai]

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