combinations generator

[natsu]

Hey, I am trying to find the different combinations that can be formed by choosing 11 out of 22 objects ( i.e. C(22,11) ). I have posted below the code I tried using. the problem is that this code give me all possible combinations whereas I only need different ways in which 11 objects can be chosen out of 22.

items(1) = "albert"
  items(2) = "pane"
  items(3) = "drey"
  items(4) = "max"
  items(5) = "pat"
  items(6) = "sam"
  items(7) = "shay"
  items(8) = "hem"
  items(9) = "asa"
  items(10) = "stone"
  items(11) = "sunderland"
  items(12) = "christian"
  items(13) = "hare"
  items(14) = "rob"
  items(15) = "sir"
  items(16) = "jamie"
  items(17) = "gray"
  items(18) = "khan"
  items(19) = "missy"
  items(20) = "seed"
  items(21) = "afb"
  items(22) = "cole"
  Set x = ThisWorkbook.Sheets.Add
  For a = True To False
    For b = True To False
      For c = True To False
        For d = True To False
          For e = True To False
            For f = True To False
              For g = True To False
                For h = True To False
                  For i = True To False
                    For j = True To False
                      For k = True To False
                        For l = True To False
                          For m = True To False
                            For n = True To False
                              For o = True To False
                                For p = True To False
                                  For q = True To False
                                    For r = True To False
                                      For s = True To False
                                        For t = True To False
                                          For u = True To False
                                            For v = True To False
                                              z = z + 1
                                              txt = "("
                                              If a Then txt = txt & items(1) & ", "
                                              If b Then txt = txt & items(2) & ", "
                                              If c Then txt = txt & items(3) & ", "
                                              If d Then txt = txt & items(4) & ", "
                                              If e Then txt = txt & items(5) & ", "
                                              If f Then txt = txt & items(6) & ", "
                                              If g Then txt = txt & items(7) & ", "
                                              If h Then txt = txt & items(8) & ", "
                                              If i Then txt = txt & items(9) & ", "
                                              If j Then txt = txt & items(10) & ", "
                                              If k Then txt = txt & items(11) & ", "
                                              If l Then txt = txt & items(12) & ", "
                                              If m Then txt = txt & items(13) & ", "
                                              If n Then txt = txt & items(14) & ", "
                                              If o Then txt = txt & items(15) & ", "
                                              If p Then txt = txt & items(16) & ", "
                                              If q Then txt = txt & items(17) & ", "
                                              If r Then txt = txt & items(18) & ", "
                                              If s Then txt = txt & items(19) & ", "
                                              If t Then txt = txt & items(20) & ", "
                                              If u Then txt = txt & items(21) & ", "
                                              If v Then txt = txt & items(22) & ", "
                                              txt = txt & ")"
                                              txt = Replace(txt, ", )", ")")
                                              x.Cells(z, 1).Value = z
                                              x.Cells(z, 2).Value = txt
                                            Next v
                                          Next u
                                        Next t
                                      Next s
                                    Next r
                                  Next q
                                Next p
                              Next o
                            Next n
                          Next m
                        Next l
                      Next k
                    Next j
                  Next i
                Next h
              Next g
            Next f
          Next e
        Next d
      Next c
    Next b
  Next a
  MsgBox z & " combinations found.", vbInformation
End Sub

 

[Marc L]

​

According to Excel / VBA basics, on my old tests slow laptop, it needs around 3 seconds to generate the 705 432 combinations​

and 7 seconds more to copy them to a worksheet, so all the process lasts around 10 seconds with around 25 VBA codelines …​

 

[Marc L]

​

Sorry, another application was running so with Excel alone it's 2 + 6 so ~ 8 seconds. The trick is to use a 'single' loop and arrays …​

​

How many time on your side ? But as you have already marked a post as the solution, should we go on a new thread ?​

 

[natsu]

​

Sorry, another application was running so with Excel alone it's 2 + 6 so ~ 8 seconds. The trick is to use a 'single' loop and arrays …​

​

How many time on your side ? But as you have already marked a post as the solution, should we go on a new thread ?​

Mine took around 30-40 seconds for the whole process. It should lower once I stop All other applications.

 

[Marc L]

​

My old VBA demonstration generates the combinations in memory then allocates the list to column A of the active sheet,​

could be a specific worksheet if the code is located in the worksheet module … Ok or need somethin' else ?​

 

[natsu]

​

My old VBA demonstration generates the combinations in memory then allocates the list to column A of the active sheet,​

could be a specific worksheet if the code is located in the worksheet module … Ok or need somethin' else​

Nope I am all set. Thanks for your time ?

 

[Marc L]

The 8 seconds VBA demonstration as a beginner starter to paste to the top of a module :​

Const K = 11

Dim R&, S$(), T$(1 To K), V, W

Sub Combinate(Optional C& = 1, Optional P& = 1)
    For P = P To W(C)
        T(C) = V(P)
        If C < K Then Combinate C + 1, P + 1 Else R = R + 1: S(R, 0) = Join(T, ", ")
    Next
End Sub

Sub Demo1()
    Dim N&
    [A1].CurrentRegion.Clear
    V = Split(" albert pane drey max pat sam shay hem asa stone sunderland christian are rob sir jamie gray khan missy seed afb cole")
    N = UBound(V):  If N <= K Then Beep: Exit Sub
    ReDim S(1 To Evaluate("COMBIN(" & N & "," & K & ")"), 0)
    R = 0
    W = Evaluate("COLUMN(" & Cells(N - K + 1).Resize(, K).Address & ")")
    Combinate
    With [A1].Resize(R):  .Value2 = S:  .Columns.AutoFit:  End With
    Erase S, T, V, W
End Sub

 

[natsu]

The 8 seconds VBA demonstration as a beginner starter to paste to the top of a module :​

Const K = 11

Dim R&, S$(), T$(1 To K), V, W

Sub Combinate(Optional C& = 1, Optional P& = 1)
    For P = P To W(C)
        T(C) = V(P)
        If C < K Then Combinate C + 1, P + 1 Else R = R + 1: S(R, 0) = Join(T, ", ")
    Next
End Sub

Sub Demo1()
    Dim N&
    [A1].CurrentRegion.Clear
    V = Split(" albert pane drey max pat sam shay hem asa stone sunderland christian are rob sir jamie gray khan missy seed afb cole")
    N = UBound(V):  If N <= K Then Beep: Exit Sub
    ReDim S(1 To Evaluate("COMBIN(" & N & "," & K & ")"), 0)
    R = 0
    W = Evaluate("COLUMN(" & Cells(N - K + 1).Resize(, K).Address & ")")
    Combinate
    With [A1].Resize(R):  .Value2 = S:  .Columns.AutoFit:  End With
    Erase S, T, V, W
End Sub

This worked way faster. Thanks @Marc L

 

[Marc L]

​

Thanks for the likes !​

​

How many time it requires on your side ?​

 

[natsu]

​

Thanks for the likes !​

​

How many time it requires on your side ?​

Done in 10 seconds!!

 

[Marc L]

​

Ok so my old laptop is not so slow or you have another application running with Excel …​