[RESOLVED] Excel VBA code for n taken r at a time

When choosing 3 balls out of 5 where order does not matter and without repetitions:
----------
# combinations = nCr
= n!
(n-r)! r!
= 5!
(5-3)! 3!
= 5!
2! 3!
= 10

Does anyone have VBA code that will generate the 10 combinations? The code needs to be flexible so that n and r can vary. For example if the 'n' numbers were 10 20 30 40 and 50, and 'r' is 3 the result should be:
10 20 30
10 20 40
10 20 50
10 30 40
10 30 50
10 40 50
20 30 40
20 30 50
20 40 50
30 40 50

Quote:

---

Originally Posted by MartinLiss

When choosing 3 balls out of 5 where order does not matter and without repetitions:

---

That's classic Lottery.
I think i have a somewhat generic Function for that.
Give me a few minutes.....

EDIT: Crap. Forget what i said
You want the possible combinations.....

Found something:
https://www.vitoshacademy.com/vba-all-combinations/

Code:

---

Sub Main()
   
    Dim size As Long: size = 3
    Dim initialArray As Variant: initialArray = Array(10, 20, 30, 40, 50)
    Dim arr As Variant: ReDim arr(size - 1)
    Dim n As Long: n = UBound(arr) + 1
   
    EmbeddedLoops 0, size, initialArray, n, arr
   
End Sub
 
Function EmbeddedLoops(index As Long, size As Long, initialArray As Variant, n As Long, arr As Variant)
   
    Dim p As Variant
   
    If index >= size Then
        If Not AnyValueBiggerThanNext(arr) And Not AnyValueIsRepeated(arr) Then
            PrintArrayOnSingleLine arr
        End If
    Else
        For Each p In initialArray
            arr(index) = p
            EmbeddedLoops index + 1, size, initialArray, n, arr
        Next p
    End If
   
End Function
 
Public Function AnyValueBiggerThanNext(arr As Variant) As Boolean
 
    Dim i As Long
    For i = LBound(arr) To UBound(arr) - 1
        If arr(i) > arr(i + 1) Then
            AnyValueBiggerThanNext = True
            Exit Function
        End If
    Next i
   
    AnyValueBiggerThanNext = False
 
End Function
 
Public Function AnyValueIsRepeated(arr As Variant) As Boolean
           
    On Error GoTo AnyValueIsRepeated_Error:
   
    Dim element As Variant
    Dim testCollection As New Collection
   
    For Each element In arr
        testCollection.Add "item", CStr(element)
    Next element
   
    AnyValueIsRepeated = False
   
    On Error GoTo 0
    Exit Function
   
AnyValueIsRepeated_Error:
    AnyValueIsRepeated = True
   
End Function
 
Public Sub PrintArrayOnSingleLine(myArray As Variant)
 
    Dim i As Long
    Dim textArray As String
   
    For i = LBound(myArray) To UBound(myArray)
        textArray = textArray & " " & myArray(i)
    Next i
   
    Debug.Print textArray
   
End Sub

---

I don't know why, but I don't get email notifications when someone answers one of my questions, so not having heard anything I went ahead and searched the web until I found code (different from yours) that I'm using.

In any case thanks for doing the research.

Quote:

---

Originally Posted by MartinLiss

I don't know why, but I don't get email notifications when someone answers one of my questions,

---

The "Reply to Thread"-mechanism is buggy right now

Here's another problem - I see "Last edited by Zvoni; Tomorrow at 31:69 PM." in your comment:)

Quote:

---

Originally Posted by MartinLiss

Here's another problem - I see "Last edited by Zvoni; Tomorrow at 31:69 PM." in your comment:)

---

It's called a "Signature" :bigyello:

btw: The "Reply-To-Thread"-Notification actually does work, but for some unfathomable reason it permanently lands in my Spam-Folder, and nothing i do gets it out (Whitelist, whatever)