combinations generator

natsu

New Member
Joined
Apr 28, 2021
Messages
9
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
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.


VBA Code:
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

Well-known Member
Joined
Apr 5, 2021
Messages
944
Office Version
  1. 2010
Platform
  1. Windows
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 …​
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
944
Office Version
  1. 2010
Platform
  1. Windows
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

New Member
Joined
Apr 28, 2021
Messages
9
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
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

Well-known Member
Joined
Apr 5, 2021
Messages
944
Office Version
  1. 2010
Platform
  1. Windows
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

New Member
Joined
Apr 28, 2021
Messages
9
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Apr 5, 2021
Messages
944
Office Version
  1. 2010
Platform
  1. Windows
The 8 seconds VBA demonstration as a beginner starter to paste to the top of a module :​
VBA Code:
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
 
Solution

natsu

New Member
Joined
Apr 28, 2021
Messages
9
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

The 8 seconds VBA demonstration as a beginner starter to paste to the top of a module :​
VBA Code:
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

Well-known Member
Joined
Apr 5, 2021
Messages
944
Office Version
  1. 2010
Platform
  1. Windows
Thanks for the likes !​
How many time it requires on your side ?​
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
944
Office Version
  1. 2010
Platform
  1. Windows
Ok so my old laptop is not so slow or you have another application running with Excel …​
 

Watch MrExcel Video

Forum statistics

Threads
1,133,619
Messages
5,659,913
Members
418,536
Latest member
Tezzies

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
Top