generate combination with condtions

cds

Board Regular
Joined
Mar 25, 2012
Messages
84
I have the following macro to generate combinations, which works fine. But, I need to add conditions to create the combinations. My data is something like this

[TABLE="width: 500"]
<tbody>[TR]
[TD]a[/TD]
[TD]b[/TD]
[TD]c[/TD]
[TD]d[/TD]
[TD]e[/TD]
[TD]f[/TD]
[/TR]
[TR]
[TD]bulter[/TD]
[TD]10[/TD]
[TD]keeper[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]brown[/TD]
[TD]8[/TD]
[TD]Keeper[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]smit[/TD]
[TD]8[/TD]
[TD]all-rounder[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ryan[/TD]
[TD]9[/TD]
[TD]all-rounder[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]taylor[/TD]
[TD]9[/TD]
[TD]all-rounder[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mulaney[/TD]
[TD]7[/TD]
[TD]all-rounder[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]hales[/TD]
[TD]10[/TD]
[TD]batsman[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]clarke[/TD]
[TD]9[/TD]
[TD]batsman[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]rpry[/TD]
[TD]8[/TD]
[TD]batsman[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]right[/TD]
[TD]9[/TD]
[TD]batsman[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I want to select 5 players each in combination with the following conditions .
I want select One from Keeper catagory and minimum 1 & maximum from 2 all rounder catagory and maximum 2 & maximum 3 from batsman category and total of 5 players should not exceed say 50.

If I put the each category of players into separate columns, I have following macro which select one player from each column . Kindly assist to add above conditions .


Sub Combos()
Dim Element(), Index()
Dim MyCols As Variant, MySheet As Worksheet, OneCol As Boolean
Dim r As Long, c As Long, ctr As Long, mysize As Long
Dim delim As String, OutputCol As String, str1 As String


' Set up conditions
Set MySheet = Sheets("Sheet1")
MyCols = Array("A", "B", "C")
OutputCol = "F"
OneCol = True
delim = " - "

' resize the arrays
ReDim Element(255, UBound(MyCols))
ReDim Index(UBound(MyCols))

' Read the elements
For c = 0 To UBound(MyCols)
Element(0, c) = 0
Index(c) = 1
For r = 1 To 255
If MySheet.Cells(r, MyCols(c)) <> "" Then
Element(0, c) = Element(0, c) + 1
Element(Element(0, c), c) = MySheet.Cells(r, MyCols(c))
End If
Next r
Next c

' Clear the output columns(s), and check for the number of results
ctr = MySheet.Cells(1, OutputCol).Column
mysize = 1
For c = 0 To UBound(MyCols)
mysize = mysize * Element(0, c)
MySheet.Columns(ctr).ClearContents
ctr = ctr + 1
Next c
If mysize > 1000000 Then
MsgBox "The number of results is too big to handle!"
Exit Sub
End If

ctr = 0

' Start creating combinations
Loop1:
ctr = ctr + 1
str1 = ""
Set resultcell = MySheet.Cells(ctr, OutputCol)
For c = 0 To UBound(MyCols)
If OneCol Then
str1 = str1 & Element(Index(c), c) & delim
Else
resultcell.Value = Element(Index(c), c)
Set resultcell = resultcell.Offset(0, 1)
End If
Next c
If OneCol Then MySheet.Cells(ctr, OutputCol) = Left(str1, Len(str1) - Len(delim))

' Increment the indices
For c = 0 To UBound(MyCols)
Index(c) = Index(c) + 1
If Index(c) <= Element(0, c) Then Exit For
Index(c) = 1
Next c
If c <= UBound(MyCols) Then GoTo Loop1:

End Sub
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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
Back
Top