calculate all possible combination from 10 variables

[silvia]

Hi,
I have 10 variables and I want to write a VBA code to calculate all
possible combinations of them as the maxumum variables in a combination
(group ) could be 5 and the minimum variables in combination (group)
could be 2. For example if I have variables -- a, b, c, d, e, f, g, h,
i, j - --the max variable in combimation to be 5 - for example "a, b,
c, f, h" and minimum 2- "a, b".
Hope I made it clear..
any idea how to do that..

Thanks, silvia

 

[lexcel]

It looks interesting and I might have a solution, but I am not sure
what you really want.

do you want to create a list that looks like this?
a b
a c
a d
.....
a j
b c
b d
b e
.....
h i
h j
i j
a b c
a b d
a b e
.....
g h i
g h j
h i j
a b c d
......
g h i j
a b c d e
a b c d f
.....
e f g h i
e f g h j
e f h i j
e g h i j
f g h i j

 

[Andrew Taylor]

See the solution I gave in this thread:

http://snipurl.com/rk47

Andrew

 

[Dana DeLouis]

Here's Andrew's excellent code written as a loop.
I know this version is not too efficient. There's a vba library reference
to atpvbaen.
This fills in cells A1:A627

Sub Demo()
'// By: Dana DeLouis

Dim n As Long
Dim R As Long
Dim p As Long
Dim s As String
Dim Ans As String
Const One As String = "1"

R = 1
With WorksheetFunction
For n = 1023 To 1 Step -1
Ans = vbNullString
s = (n \ 512) & Dec2Bin(n Mod 512, 9)

Select Case Len(Replace(s, "0", vbNullString))
Case 2 To 5
For p = 1 To 10
If Mid$(s, p, 1) = One Then Ans = Ans & Chr(64 + p)
Next p
Cells(R, 1) = Ans
R = R + 1
End Select
Next n
End With
Columns("A:A").AutoFit
End Sub

I get all 627 solutions:

Sub CheckCount()
Const n As Double = 10

With WorksheetFunction
Debug.Print .Combin(n, 2) + .Combin(n, 3) + .Combin(n, 4) + .Combin(n,
5)
'or
Debug.Print (n * (n * (n * ((n - 5) * n + 25) + 5) - 26)) / 120
End With

End Sub

Returns a count of 627

 

[Dana DeLouis]

I have 10 variables ...combinations of them 2 to 5
Ahhh. Please forget that idea. This is still not efficient, but better by
not using the ATP.

Sub Demo()
'// By: Dana DeLouis

Dim n As Long
Dim p As Long
Dim R As Long
Dim W As Double
Dim F As Double
Dim Ans As String

R = 1 'Output begins @ Row 1
For n = 992 To 3 Step -1
Ans = vbNullString
F = n
p = 10
Do
W = F / 2
F = Int(W)
If W <> F Then Ans = Chr(64 + p) & Ans
p = p - 1
Loop While F <> 0

Select Case Len(Ans)
Case 2 To 5: Cells(R, 1) = Ans: R = R + 1
End Select
Next n
Columns("A:A").AutoFit
End Sub


As a side note, no sense in checking past 992 as any Binary Permutation
would have more than 5 characters.

=Bin2Dec("1111100000") + 1024
returns 992

 

[Dana DeLouis]

Well.. ahhhh.... Andrew's excellent code is 5 times faster on a larger
set!!
I really thought the loop version would be faster vs. recursion with
strings.
I tried the problem with 24 items, and searching for subsets with 2-5 items.
The number of solutions is 55,430, so it fits within 1 column in Excel.
Again, Andrew's excellent code is 5 times faster here. Thanks Andrew. :>0

--

"To understand recursion, one must first understand recursion."

Dana DeLouis

Windows XP, Office 2003

<snip>

 

[Andrew Taylor]

I'm blushing here

Andrew

 

[lexcel]

This recursive solution is very interesting, especially because of its
simplicity and relative efficiency. It is the most efficient if you
really just want to generate strings.
In the program I'm working on (a Kakuro generator/solver) I need bit
pattern representations as well and convert bitpatterns to strings and
ranges of numbers and vice versa, and also to know the number of digits
/ items in the pattern as well as the sum of all the digits.
I adapted Andrews recursive routine to accomodate Silvias request and
added my version of the sequential solution, which would be more
efficient than the recursive one if the routines BitCount() and
Bits2String() would be built-in or written in a more efficient
programming language.
Anybody any idea where I can find these? This would speed up my
solver/generator a lot. Especially the BitCount() routine.


Const PermString As String = "abcdefghij", _
MinPerm As Integer = 2, _
MaxPerm As Integer = 5

Private r As Integer

'Adapted recursive version

Sub ShowCombinations(strPrefix As String, strMain As String)
Dim strFirst As String, strRest As String
If Len(strMain) = 0 Then
If Len(strPrefix) >= MinPerm And Len(strPrefix) <= MaxPerm Then
Cells(r, 2) = strPrefix
r = r + 1
End If
Exit Sub
End If
strFirst = Left(strMain, 1)
strRest = Mid(strMain, 2)
ShowCombinations strPrefix & strFirst, strRest
ShowCombinations strPrefix, strRest
End Sub

' Sequential version

Sub Combi(Total As Integer, Lo As Integer, Hi As Integer,
Representation As String)
Dim i As Long, cnt As Integer

For i = 1 To 2 ^ Total
cnt = BitCount(i)
If cnt >= Lo And cnt <= Hi Then
Cells(r, 1) = Bits2String(i, Representation)
r = r + 1
End If
Next i

End Sub

Function BitCount(ByVal Pat As Long) As Integer

BitCount = 0
While Pat
If Pat And 1 Then BitCount = BitCount + 1
Pat = Int(Pat / 2)
Wend

End Function

Function Bits2String(ByVal BitPat As Long, SourceString As String) As
String
Dim i As Integer

Bits2String = ""
i = 1

While BitPat
If BitPat And 1 Then _
Bits2String = Bits2String & Mid(SourceString, i, 1)
i = i + 1
BitPat = Int(BitPat / 2)
Wend

End Function