Combinations macro (need modifications)

[Anka]

I found this VBA macro, that is very useful for my project and yesterday I exposed "my problem" in another forum, but without enough luck. So is a cross posting. I know that one day is shortly to have an answer, but I really need this vba. Today, after several searches with Google, I found "the owner" of this macro in this forum. And I want to try "my luck" here.

The problem - I must made one small change on this vba, but I do not know how to do. I need / want to be able to set these three constants directly in the sheet. So, I need to set my list just like in the attached picture.

I want to put in column W range W3 & last row, the n list (total number of elements)
I want to put in column X range X3 & last row, the q list (number of groups)
I want to put in column Y range Y3 & last row, the p list (number of elements per group)
Output of results start in column AS.
At this point, to get the result from the image, I need to change manually four times these constants and run for four times the macro. For this reason I need to set a list (this list may vary in number of rows), and I want to run the macro just one time to obtain that result.

If something is not explained clearly enough, feel free to ask me.
Thanks in advance for your help.

Link to Cross-Post: http://www.excelforum.com/excel-pro...13-combinations-macro-need-modifications.html

 

[Anka]

Thanks for changes Joe4.

And this is the VBA.

Option Explicit

Dim vResults As Variant ' resulting combinations
Dim vResult As Variant  ' current combination being calculated

Const n As Integer = 5 ' total number of elements
Const q As Integer = 2 ' number of groups
Const p As Integer = 2 ' number of elements per group

' PGC 2014 05
' Calculates the unique combinations of n elements in q groups of p elements each
' The order of the groups is not relevant. Ex.: ((1,2),(3,5)) is the same as ((3,5),(1,2))
Sub Combinations_n_q_p()
Dim lRow As Long, lTotal As Long, v As Variant
Dim vElements As Variant ' set of elements to use in the combinations
Dim j As Integer, lCol As Long

Columns("A:Z").Clear

' initialise
vElements = Evaluate("transpose(row(1:" & n & "))")
ReDim vResult(1 To q)
ReDim vResults(1 To q)
lTotal = Evaluate("Product(Combin(" & n & "-(Row(1:" & q & ")-1)*" & p & "," & p & "))/Fact(" & q & ")")
For j = 1 To q
    ReDim v(1 To p): vResult(j) = v
    ReDim v(1 To lTotal, 1 To p): vResults(j) = v
Next j

' calculate the combinations
Call CombinationsNP(vElements, lRow, 1, True, 1, 1)
lCol = 1
For j = 1 To q
    Cells(1, lCol).Resize(lTotal, p) = vResults(j)
    lCol = lCol + p + 1
Next j
End Sub
 
Sub CombinationsNP(ByVal vElements As Variant, lRow As Long, iGroup As Integer, bNewGroup As Boolean, iFirstElement As Integer, iIndex As Integer)
Dim vRemainingElements As Variant
Dim i As Integer, j As Integer, k As Integer
 
vRemainingElements = vElements
If bNewGroup Then
    For j = 1 To iGroup - 1
        For k = 1 To p
            vRemainingElements(vResult(j)(k)) = 0
        Next k
    Next j
    If iGroup = 1 Then iFirstElement = 1 Else iFirstElement = vResult(iGroup - 1)(1) + 1
End If

For i = iFirstElement To UBound(vElements)
    If vRemainingElements(i) > 0 Then
        vResult(iGroup)(iIndex) = vElements(i)
        If iIndex = p Then
            If iGroup = q Then
                lRow = lRow + 1
                For j = 1 To q
                    For k = 1 To p
                        vResults(j)(lRow, k) = vResult(j)(k)
                    Next k
                Next j
            Else
                Call CombinationsNP(vElements, lRow, iGroup + 1, True, 1, 1)
            End If
        Else
            Call CombinationsNP(vRemainingElements, lRow, iGroup, False, i + 1, iIndex + 1)
        End If
    End If
Next i
End Sub

 

[Anka]

Nobody can help me?

 

[Anka]

For pity's sake!

 

[Anka]

Bump

 

[Anka]

Up...

 

[Anka]

Maybe today...

 

[Anka]

Bump

 

[Anka]

Bump

 

[kalak]

Bump

I really have very little idea of the totality of what you want, however here's a VBA code that gives the same as your pic shows under OUTPUT. It can be located wherever the user likes.
Run it on a blank sheet to see ...

Sub a_combin_code()

Dim c(), y()
Dim u&, i&, j&, s&, v&, x&
u = 5: s = 1

For v = 2 To u
s = s + x: x = 0
ReDim y(1 To u ^ v, 1 To v), c(1 To u ^ v, 1 To v)
For j = 1 To v
    For i = 1 To u ^ v
        y(i, j) = 1 + Int((i - 1) / (u ^ (v - j))) Mod u
    Next i
Next j

For i = 1 To u ^ v
    For j = 2 To v
        If Not y(i, j) > y(i, j - 1) Then GoTo nxti
    Next j
    x = x + 1
    For j = 1 To v
        c(x, j) = y(i, j)
    Next j
nxti:
Next i

Cells(s, 1).Resize(x, v).Value = c
Next v

End Sub