Tom Ogilvy's VBA code

[Maxi]

Sub Combinations()
Dim n As Integer, m As Integer
numcomb = 0
n = InputBox("Number of items?", "Combinations")
m = InputBox("Taken how many at a time?", "Combinations")
Comb2 n, m, 1, "'"
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String)
If m > n - k + 1 Then Exit Sub
If m = 0 Then
ActiveCell = s
ActiveCell.Offset(1, 0).Select
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " "
Comb2 n, m, k + 1, s
End Sub

I am referring to the above code written by Tom Ogilvy and trying to
manipulate it to meet my requirement but I did not get any success
inspite of trying so many times.

Before I explain what exactly I want, I would like to tell you guys
that I have the following data in A1:T1
3,4,6,10,11,13,18,21,30,32,33,35,46,53,60,67,69,74,77,78

Manipulation required:
----------------------
1. Tom's code gives the result as a string separated by a SPACE and I
want it in integers in different cells.
2. Tom's code gives flexibility to the user to choose "Number of items"
and "Taken how many times". In my case items will always be 20 (data in
range A1:T1) and "Taken how many times" will depend on user input
(Min:2 and Max:10)
3. For instance, if n=20 (it will always be 20) and m=5 (user input)
then Tom's code will generate the first combination as 1 2 3 4 5
whereas the result what I want is 3 4 6 10 11 (in different cells)

I will use Tom's combination 1 2 3 4 5 as offsets to find out my
combination 3 4 6 10 11 which is cells(1,1).value cells(1,2).value
cells(1,3).value cells(1,4).value cells(1,5).value given in the range
A1:T1

Original problem:
--------------------
Actually I have posted a different question in the link given below for
which I am not getting any replies and therefore I have decided to work
on that myself but I need a start as am confused how and where to start
with.

http://groups.google.com/group/micr...read/thread/4568c79732db4eba/624a5d06ae786d57

If anybody can clear my doubts and change the above code according to
my requirement then probably I can start working on my original post. I
am not sure whether I will be able to do it completely but atleast I
can try.

It would be great if Tom or any of the pros in this group can have a
look at my original post and suggest a logic on how to do it.
http://groups.google.com/group/micr...read/thread/4568c79732db4eba/624a5d06ae786d57

Many Thanks
Maxi

 

[Tom Ogilvy]

Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
numcomb = 0
Set rng = Range("A1:T1")
'Set rng = rng.Resize(1, 5)
v = Application.Transpose(Application _
.Transpose(rng))
n = UBound(v, 1)
m = InputBox("Taken how many at a time?", "Combinations")
If Application.Combin(n, m) > 64530 Then
MsgBox "Too many to write out, quitting"
Exit Sub
End If
Range("A3").Select
Comb2 n, m, 1, "'", v
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m > n - k + 1 Then Exit Sub
If m = 0 Then
'Debug.Print "->" & s & "<-"
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
ActiveCell.Offset(0, i) = v(v1(i))
Next
ActiveCell.Offset(1, 0).Select
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v
Comb2 n, m, k + 1, s, v
End Sub

will generate the combinations of which you speak.

 

[Maxi]

Thank you Tom.

This will definitely give me a start for the other post that I
discussed. It will take a very long time for me to finish. If at all I
get success to write the entire code by myself, I will get back to you
and would request you to check it once whether that is the efficient
way of doing it. Please give me your inputs if there is any
optimisation required.

http://groups.google.com/group/micr...read/thread/4568c79732db4eba/624a5d06ae786d57

Thanks
Maxi

 

[Maxi]

I am getting errors while submitting a reply and not sure if it went
through. Trying it again and it might appear twice.

I tried a lot but I am not getting a correct solution. I am still
trying to finish this. I would appreciate if you can help me with this.
For you it will be a cake walk. Let me reiterate my problem with a
little change in it. I have also thought of a logic on how to do it
(explained below) but I am not able to write a correct code to process
that logic. Please help.

Lets say I have the following data in cell A1:T10
3,4,7,9,10,11,21,32,33,35,37,41,47,57,60,64,69,72,74,75
3,4,6,10,11,13,18,21,30,32,33,35,46,53,60,67,69,74,77,78
4,7,13,15,17,25,29,32,37,42,45,47,50,57,60,64,68,71,72,74
4,7,9,10,11,20,28,29,30,32,34,35,40,41,49,52,66,69,70,74
3,4,8,10,14,20,21,23,28,29,32,37,44,47,48,49,56,64,69,72
1,3,7,11,14,18,27,33,35,37,39,41,45,47,48,53,64,65,75,77
3,7,10,11,16,18,28,34,35,43,47,51,52,55,56,57,60,64,71,72
4,6,9,10,15,21,31,33,34,41,42,45,46,47,57,60,68,72,74,78
4,6,9,10,12,13,15,21,22,31,35,47,49,52,56,63,64,72,74,75
3,4,7,10,14,17,18,21,28,31,33,36,37,43,47,57,65,69,75,80

I have made a change in your code. The line Range("A3").Select is
changed to Range("V1").Select so that the combinations that are being
generated will be placed to the right of column V and I have also
commented the following because I want to process all possible
combinations.
If Application.Combin(n, m) > 64530 Then
MsgBox "Too many to write out, quitting"
Exit Sub
End If

I need one more prompt that will ask for "How many matches?" Lets
assume I enter 4 for this and "Taken how many at a time?" as 5

Considering the above:

The first combination that it will create in range V1:Z1 is 3 4 7 9 10
per your code. Now I want to check this combination in all 10 rows
including the first one where there are >=4 matches. All these 5
numbers are present in row 1 (A1:T1) then frequency variable will hold
the value 1. The next match is in row 4 where 4 7 9 10 matched
therefore frequency variable value will increment to 2. The next match
is in row 10 where 3 4 7 10 matched therefore frequency variable value
will increment to 3. Lets put this value in AG1 (AG1.value = 3 which is
the frequency for first combination 3 4 7 9 10). Here Offset to next
row (Your code will take the cursor in V2). Reset frequency value to 0.

The second combination that it will create in range V2:Z2 is 3 4 7 9 11
per your code. Now I want to check this combination in all 10 rows
where there are >=4 matches. All these 5 numbers are present in row 1
(A1:T1) then frequency variable will hold the value 1. The next match
is in row 4 where 4 7 9 11 matched therefore frequency variable value
will increment to 2. There are no more matches. Delete this combination
from range V2:Z2 as the frequency is lower that the one listed
previously. Offset the cursor to V2 again and reset the frequency value
to 0.

The thirteenth combination that it will create in range V2:Z2 is 3 4 7
9 69 per your code. Now I want to check this combination in all 10
rows where there are >=4 matches. All these 5 numbers are present in
row 1 (A1:T1) then frequency variable will hold the value 1. The next
match is in row 4 where 4 7 9 69 matched therefore frequency variable
value will increment to 2. The next match is in row 10 where 3 4 7 69
matched therefore frequency variable value will increment to 3. Lets
put this value in AG2 (AG2.value = 3). We don't have to delete this
combination from range V2:Z2 as the frequency is equal to the one
listed previously. Offset the cursor to V3 and reset the frequency
value to 0.

** H e r e i s a t w i s t ** The seventeenth combination that it
will create in range V3:Z3 is 3 4 7 10 11 per your code. Now I want to
check this combination in all 10 rows where there are >=4 matches. All
these 5 numbers are present in row 1 (A1:T1) then frequency variable
will hold the value 1. Besides this it also matches in rows 2nd 4th 7th
and 10th therefore frequency variable will hold the value 5 which is
more than the first two combinations where the frequency was 3. In such
a scenario, delete everything in the range V1:AG65536 set the cursor
back to V1 and list this combination (3 4 7 10 11) where the frequency
is 5 and put the frequency value )5) in AG1 (AG1.value = 5).

Once we are done with all the 15504 combinations. Then start creating
combinations for the second row
3,4,6,10,11,13,18,21,30,32,33,35,46,53,60,67,69,74,77,78 and follow the
same above process. Do this same task for all the 10 rows. These 10
rows are just samples, it will be more than 10.

When the vba codes finishes, it will give me best combination(s) of 5
numbers where any 4 numbers matches with the highest frequency in given
sample of 10 rows and it will also show me the frequency in column AG.

Please let me know if the logic I explained above is good and will
consume appropriate time.

 

[Maxi]

The problem is solved. However I have few doubts

Summary of the problem
======================

I got hold of a vba code by Myrna Larson (July 25, 2000,
Microsoft.Public.Excel.Misc) which is used to list permutation and
combinations. It requires two 3 things:
1. What do you want to list (Permutations/combinations) Enter "C" or
"P" in cell A1
2. How many numbers do you want in a combination. Enter this in cell A2
3. List numbers vertically from cell A3 of which you need to list
combinations.

I have modified this vba code and added two more criteria:
1. How many matches. Enter in cell B1
2. What frequency? Enter in cell C1

Please download this excel file to see how it runs.
http://www40.brinkster.com/Maxlott/try.htm

In this example, I have 17 draws listed in range F1:Y17. Following is
the criteria I have used
A1 = C (I want to create combinations)
A2 = 3 (I want to create combinations of 3 numbers each)
B1 = 3 (I want to match all 3 numbers)
C1 = 6 (List combinations only if all the 3 numbers (matches) in a
combination apprears in more than or equal to 6 draws.

If you run the macro (DoIt) it will list only 42 combiations out of
19380 (=COMBIN(20,3)*17). These 42 combinations comply to the above
criterias given. If you check any combinations, you will see that all
three numbers matches in more than or equal to 6 draws. (Only thing
which is pending in this code is that it also lists duplicates which I
will remove later)

What I want more : Optimization
===============================

I have observed that on my computer (Intel Celeron 800 MHz 256MB SDRAM)
the total time it takes is 14:52 minutes to complete the code with the
criteria (Combinations A2=3, Matches B1=3 and frequency C1=6). If I
remove the conditional formatting in the range AC11:AL11 the total time
reduces to 12:45. If I remove the progress counter from the cell AI9
(by commenting the line combins = combins + 1 and Range("AI9").Value =
Format(combins / Range("AI7").Value, "00.00%")) then the time reduces
to 12:14. If I set the screen updating to FALSE, the total time reduces
considerably to 2:35 which is great.

Now I want you or somebody else to check my modified code to see if the
total time can be reduced more. I want this becuase when I want to
create combinations of 10 numbers, it should not consume unnecessary
time.

I have commented all lines prefexing it with '**

For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Range("AC1").Offset(0, z) = vAllItems(ItemsChosen(i), 1) '**
added to list each combinations
z = z + 1 '**
added in the rage AC1:AL1
Next i

'and save it in the buffer
z = 1 '**
added
combins = combins + 1
Range("AI9").Value = Format(combins / Range("AI7").Value, "00.00%") '**
added

If Range("AN1").Value >= Range("C1").Value Then '**
added ( adds to buffer only if the combination matches the criteria
[combinations, matches, frequency] )
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3) & " > " & Range("AN1").Value '**
added (& " > " & Range("AN1").Value to find out the frequency)
End If

I am not sure if the approach/logic I followed is correct and need
feedback from VBA Experts like you. I have used a combination of VBA
and Excel formulas to fulfil my requirement. Please let me know if it
is correct and whether it can be changed to reduce more time and
improve on efficiency.

Maxi

 

[Paul Black]

Hi Maxi,

This is Interesting, will it be Possible for you to Post the Entire
Code that you are Using Please.

All the Best.
Paul

The problem is solved. However I have few doubts

Summary of the problem
======================

I got hold of a vba code by Myrna Larson (July 25, 2000,
Microsoft.Public.Excel.Misc) which is used to list permutation and
combinations. It requires two 3 things:
1. What do you want to list (Permutations/combinations) Enter "C" or
"P" in cell A1
2. How many numbers do you want in a combination. Enter this in cell A2
3. List numbers vertically from cell A3 of which you need to list
combinations.

I have modified this vba code and added two more criteria:
1. How many matches. Enter in cell B1
2. What frequency? Enter in cell C1

Please download this excel file to see how it runs.
http://www40.brinkster.com/Maxlott/try.htm

In this example, I have 17 draws listed in range F1:Y17. Following is
the criteria I have used
A1 = C (I want to create combinations)
A2 = 3 (I want to create combinations of 3 numbers each)
B1 = 3 (I want to match all 3 numbers)
C1 = 6 (List combinations only if all the 3 numbers (matches) in a
combination apprears in more than or equal to 6 draws.

If you run the macro (DoIt) it will list only 42 combiations out of
19380 (=COMBIN(20,3)*17). These 42 combinations comply to the above
criterias given. If you check any combinations, you will see that all
three numbers matches in more than or equal to 6 draws. (Only thing
which is pending in this code is that it also lists duplicates which I
will remove later)

What I want more : Optimization
===============================

I have observed that on my computer (Intel Celeron 800 MHz 256MB SDRAM)
the total time it takes is 14:52 minutes to complete the code with the
criteria (Combinations A2=3, Matches B1=3 and frequency C1=6). If I
remove the conditional formatting in the range AC11:AL11 the total time
reduces to 12:45. If I remove the progress counter from the cell AI9
(by commenting the line combins = combins + 1 and Range("AI9").Value =
Format(combins / Range("AI7").Value, "00.00%")) then the time reduces
to 12:14. If I set the screen updating to FALSE, the total time reduces
considerably to 2:35 which is great.

Now I want you or somebody else to check my modified code to see if the
total time can be reduced more. I want this becuase when I want to
create combinations of 10 numbers, it should not consume unnecessary
time.

I have commented all lines prefexing it with '**

For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Range("AC1").Offset(0, z) = vAllItems(ItemsChosen(i), 1) '**
added to list each combinations
z = z + 1 '**
added in the rage AC1:AL1
Next i

'and save it in the buffer
z = 1 '**
added
combins = combins + 1
Range("AI9").Value = Format(combins / Range("AI7").Value, "00.00%") '**
added

If Range("AN1").Value >= Range("C1").Value Then '**
added ( adds to buffer only if the combination matches the criteria
[combinations, matches, frequency] )
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3) & " > " & Range("AN1").Value '**
added (& " > " & Range("AN1").Value to find out the frequency)
End If

I am not sure if the approach/logic I followed is correct and need
feedback from VBA Experts like you. I have used a combination of VBA
and Excel formulas to fulfil my requirement. Please let me know if it
is correct and whether it can be changed to reduce more time and
improve on efficiency.

Maxi

I am getting errors while submitting a reply and not sure if it went
through. Trying it again and it might appear twice.

I tried a lot but I am not getting a correct solution. I am still
trying to finish this. I would appreciate if you can help me with this.
For you it will be a cake walk.

 

[Maxi]

You can get the entire code by downloading the file from the following
link:

http://www40.brinkster.com/Maxlott/try.htm

Hi Maxi,

This is Interesting, will it be Possible for you to Post the Entire
Code that you are Using Please.

All the Best.
Paul

The problem is solved. However I have few doubts

Summary of the problem
======================

I got hold of a vba code by Myrna Larson (July 25, 2000,
Microsoft.Public.Excel.Misc) which is used to list permutation and
combinations. It requires two 3 things:
1. What do you want to list (Permutations/combinations) Enter "C" or
"P" in cell A1
2. How many numbers do you want in a combination. Enter this in cell A2
3. List numbers vertically from cell A3 of which you need to list
combinations.

I have modified this vba code and added two more criteria:
1. How many matches. Enter in cell B1
2. What frequency? Enter in cell C1

Please download this excel file to see how it runs.
http://www40.brinkster.com/Maxlott/try.htm

In this example, I have 17 draws listed in range F1:Y17. Following is
the criteria I have used
A1 = C (I want to create combinations)
A2 = 3 (I want to create combinations of 3 numbers each)
B1 = 3 (I want to match all 3 numbers)
C1 = 6 (List combinations only if all the 3 numbers (matches) in a
combination apprears in more than or equal to 6 draws.

If you run the macro (DoIt) it will list only 42 combiations out of
19380 (=COMBIN(20,3)*17). These 42 combinations comply to the above
criterias given. If you check any combinations, you will see that all
three numbers matches in more than or equal to 6 draws. (Only thing
which is pending in this code is that it also lists duplicates which I
will remove later)

What I want more : Optimization
===============================

I have observed that on my computer (Intel Celeron 800 MHz 256MB SDRAM)
the total time it takes is 14:52 minutes to complete the code with the
criteria (Combinations A2=3, Matches B1=3 and frequency C1=6). If I
remove the conditional formatting in the range AC11:AL11 the total time
reduces to 12:45. If I remove the progress counter from the cell AI9
(by commenting the line combins = combins + 1 and Range("AI9").Value =
Format(combins / Range("AI7").Value, "00.00%")) then the time reduces
to 12:14. If I set the screen updating to FALSE, the total time reduces
considerably to 2:35 which is great.

Now I want you or somebody else to check my modified code to see if the
total time can be reduced more. I want this becuase when I want to
create combinations of 10 numbers, it should not consume unnecessary
time.

I have commented all lines prefexing it with '**

For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Range("AC1").Offset(0, z) = vAllItems(ItemsChosen(i), 1) '**
added to list each combinations
z = z + 1 '**
added in the rage AC1:AL1
Next i

'and save it in the buffer
z = 1 '**
added
combins = combins + 1
Range("AI9").Value = Format(combins / Range("AI7").Value, "00.00%") '**
added

If Range("AN1").Value >= Range("C1").Value Then '**
added ( adds to buffer only if the combination matches the criteria
[combinations, matches, frequency] )
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3) & " > " & Range("AN1").Value '**
added (& " > " & Range("AN1").Value to find out the frequency)
End If

I am not sure if the approach/logic I followed is correct and need
feedback from VBA Experts like you. I have used a combination of VBA
and Excel formulas to fulfil my requirement. Please let me know if it
is correct and whether it can be changed to reduce more time and
improve on efficiency.

Maxi

I am getting errors while submitting a reply and not sure if it went
through. Trying it again and it might appear twice.

I tried a lot but I am not getting a correct solution. I am still
trying to finish this. I would appreciate if you can help me with this.
For you it will be a cake walk.

 

[Paul Black]

Thanks Maxi,

Is there an easy way to use it please.

All the Best.
Paul

You can get the entire code by downloading the file from the following
link:

http://www40.brinkster.com/Maxlott/try.htm

Hi Maxi,

This is Interesting, will it be Possible for you to Post the Entire
Code that you are Using Please.

All the Best.
Paul

The problem is solved. However I have few doubts

Summary of the problem
======================

I got hold of a vba code by Myrna Larson (July 25, 2000,
Microsoft.Public.Excel.Misc) which is used to list permutation and
combinations. It requires two 3 things:
1. What do you want to list (Permutations/combinations) Enter "C" or
"P" in cell A1
2. How many numbers do you want in a combination. Enter this in cell A2
3. List numbers vertically from cell A3 of which you need to list
combinations.

I have modified this vba code and added two more criteria:
1. How many matches. Enter in cell B1
2. What frequency? Enter in cell C1

Please download this excel file to see how it runs.
http://www40.brinkster.com/Maxlott/try.htm

In this example, I have 17 draws listed in range F1:Y17. Following is
the criteria I have used
A1 = C (I want to create combinations)
A2 = 3 (I want to create combinations of 3 numbers each)
B1 = 3 (I want to match all 3 numbers)
C1 = 6 (List combinations only if all the 3 numbers (matches) in a
combination apprears in more than or equal to 6 draws.

If you run the macro (DoIt) it will list only 42 combiations out of
19380 (=COMBIN(20,3)*17). These 42 combinations comply to the above
criterias given. If you check any combinations, you will see that all
three numbers matches in more than or equal to 6 draws. (Only thing
which is pending in this code is that it also lists duplicates which I
will remove later)

What I want more : Optimization
===============================

I have observed that on my computer (Intel Celeron 800 MHz 256MB SDRAM)
the total time it takes is 14:52 minutes to complete the code with the
criteria (Combinations A2=3, Matches B1=3 and frequency C1=6). If I
remove the conditional formatting in the range AC11:AL11 the total time
reduces to 12:45. If I remove the progress counter from the cell AI9
(by commenting the line combins = combins + 1 and Range("AI9").Value =
Format(combins / Range("AI7").Value, "00.00%")) then the time reduces
to 12:14. If I set the screen updating to FALSE, the total time reduces
considerably to 2:35 which is great.

Now I want you or somebody else to check my modified code to see if the
total time can be reduced more. I want this becuase when I want to
create combinations of 10 numbers, it should not consume unnecessary
time.

I have commented all lines prefexing it with '**

For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Range("AC1").Offset(0, z) = vAllItems(ItemsChosen(i), 1) '**
added to list each combinations
z = z + 1 '**
added in the rage AC1:AL1
Next i

'and save it in the buffer
z = 1 '**
added
combins = combins + 1
Range("AI9").Value = Format(combins / Range("AI7").Value, "00.00%") '**
added

If Range("AN1").Value >= Range("C1").Value Then '**
added ( adds to buffer only if the combination matches the criteria
[combinations, matches, frequency] )
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3) & " > " & Range("AN1").Value '**
added (& " > " & Range("AN1").Value to find out the frequency)
End If

I am not sure if the approach/logic I followed is correct and need
feedback from VBA Experts like you. I have used a combination of VBA
and Excel formulas to fulfil my requirement. Please let me know if it
is correct and whether it can be changed to reduce more time and
improve on efficiency.

Maxi

Maxi wrote:
I am getting errors while submitting a reply and not sure if it went
through. Trying it again and it might appear twice.

I tried a lot but I am not getting a correct solution. I am still
trying to finish this. I would appreciate if you can help me with this.
For you it will be a cake walk.

 

[Maxi]

Hi! Paul,

I know its kind of confusing but even I am looking out for some easy
way and that it the reason I have posted this code here to seek help
from some excel vba gurus.

Maxi

Thanks Maxi,

Is there an easy way to use it please.

All the Best.
Paul

You can get the entire code by downloading the file from the following
link:

http://www40.brinkster.com/Maxlott/try.htm

Hi Maxi,

This is Interesting, will it be Possible for you to Post the Entire
Code that you are Using Please.

All the Best.
Paul

Maxi wrote:
The problem is solved. However I have few doubts

Summary of the problem
======================

I got hold of a vba code by Myrna Larson (July 25, 2000,
Microsoft.Public.Excel.Misc) which is used to list permutation and
combinations. It requires two 3 things:
1. What do you want to list (Permutations/combinations) Enter "C" or
"P" in cell A1
2. How many numbers do you want in a combination. Enter this in cell A2
3. List numbers vertically from cell A3 of which you need to list
combinations.

I have modified this vba code and added two more criteria:
1. How many matches. Enter in cell B1
2. What frequency? Enter in cell C1

Please download this excel file to see how it runs.
http://www40.brinkster.com/Maxlott/try.htm

In this example, I have 17 draws listed in range F1:Y17. Following is
the criteria I have used
A1 = C (I want to create combinations)
A2 = 3 (I want to create combinations of 3 numbers each)
B1 = 3 (I want to match all 3 numbers)
C1 = 6 (List combinations only if all the 3 numbers (matches) in a
combination apprears in more than or equal to 6 draws.

If you run the macro (DoIt) it will list only 42 combiations out of
19380 (=COMBIN(20,3)*17). These 42 combinations comply to the above
criterias given. If you check any combinations, you will see that all
three numbers matches in more than or equal to 6 draws. (Only thing
which is pending in this code is that it also lists duplicates which I
will remove later)

What I want more : Optimization
===============================

I have observed that on my computer (Intel Celeron 800 MHz 256MB SDRAM)
the total time it takes is 14:52 minutes to complete the code with the
criteria (Combinations A2=3, Matches B1=3 and frequency C1=6). If I
remove the conditional formatting in the range AC11:AL11 the total time
reduces to 12:45. If I remove the progress counter from the cell AI9
(by commenting the line combins = combins + 1 and Range("AI9").Value =
Format(combins / Range("AI7").Value, "00.00%")) then the time reduces
to 12:14. If I set the screen updating to FALSE, the total time reduces
considerably to 2:35 which is great.

Now I want you or somebody else to check my modified code to see if the
total time can be reduced more. I want this becuase when I want to
create combinations of 10 numbers, it should not consume unnecessary
time.

I have commented all lines prefexing it with '**

For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Range("AC1").Offset(0, z) = vAllItems(ItemsChosen(i), 1) '**
added to list each combinations
z = z + 1 '**
added in the rage AC1:AL1
Next i

'and save it in the buffer
z = 1 '**
added
combins = combins + 1
Range("AI9").Value = Format(combins / Range("AI7").Value, "00.00%") '**
added

If Range("AN1").Value >= Range("C1").Value Then '**
added ( adds to buffer only if the combination matches the criteria
[combinations, matches, frequency] )
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3) & " > " & Range("AN1").Value '**
added (& " > " & Range("AN1").Value to find out the frequency)
End If

I am not sure if the approach/logic I followed is correct and need
feedback from VBA Experts like you. I have used a combination of VBA
and Excel formulas to fulfil my requirement. Please let me know if it
is correct and whether it can be changed to reduce more time and
improve on efficiency.

Maxi

Maxi wrote:
I am getting errors while submitting a reply and not sure if it went
through. Trying it again and it might appear twice.

I tried a lot but I am not getting a correct solution. I am still
trying to finish this. I would appreciate if you can help me with this.
For you it will be a cake walk.

 

[Paul Black]

Hi Maxi,

One thing I Noticed is that if you Change the Criteria and Run it again
it Adds the NEW Combinations Output to the Bottom of the OLD ( Previous
) Combinations Output.

All the Best.
Paul

Hi! Paul,

I know its kind of confusing but even I am looking out for some easy
way and that it the reason I have posted this code here to seek help
from some excel vba gurus.

Maxi

Thanks Maxi,

Is there an easy way to use it please.

All the Best.
Paul

You can get the entire code by downloading the file from the following
link:

http://www40.brinkster.com/Maxlott/try.htm

Paul Black wrote:
Hi Maxi,

This is Interesting, will it be Possible for you to Post the Entire
Code that you are Using Please.

All the Best.
Paul

Maxi wrote:
The problem is solved. However I have few doubts

Summary of the problem
======================

I got hold of a vba code by Myrna Larson (July 25, 2000,
Microsoft.Public.Excel.Misc) which is used to list permutation and
combinations. It requires two 3 things:
1. What do you want to list (Permutations/combinations) Enter "C" or
"P" in cell A1
2. How many numbers do you want in a combination. Enter this in cell A2
3. List numbers vertically from cell A3 of which you need to list
combinations.

I have modified this vba code and added two more criteria:
1. How many matches. Enter in cell B1
2. What frequency? Enter in cell C1

Please download this excel file to see how it runs.
http://www40.brinkster.com/Maxlott/try.htm

In this example, I have 17 draws listed in range F1:Y17. Following is
the criteria I have used
A1 = C (I want to create combinations)
A2 = 3 (I want to create combinations of 3 numbers each)
B1 = 3 (I want to match all 3 numbers)
C1 = 6 (List combinations only if all the 3 numbers (matches) in a
combination apprears in more than or equal to 6 draws.

If you run the macro (DoIt) it will list only 42 combiations out of
19380 (=COMBIN(20,3)*17). These 42 combinations comply to the above
criterias given. If you check any combinations, you will see that all
three numbers matches in more than or equal to 6 draws. (Only thing
which is pending in this code is that it also lists duplicates which I
will remove later)

What I want more : Optimization
===============================

I have observed that on my computer (Intel Celeron 800 MHz 256MB SDRAM)
the total time it takes is 14:52 minutes to complete the code with the
criteria (Combinations A2=3, Matches B1=3 and frequency C1=6). If I
remove the conditional formatting in the range AC11:AL11 the total time
reduces to 12:45. If I remove the progress counter from the cell AI9
(by commenting the line combins = combins + 1 and Range("AI9").Value =
Format(combins / Range("AI7").Value, "00.00%")) then the time reduces
to 12:14. If I set the screen updating to FALSE, the total time reduces
considerably to 2:35 which is great.

Now I want you or somebody else to check my modified code to see if the
total time can be reduced more. I want this becuase when I want to
create combinations of 10 numbers, it should not consume unnecessary
time.

I have commented all lines prefexing it with '**

For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Range("AC1").Offset(0, z) = vAllItems(ItemsChosen(i), 1) '**
added to list each combinations
z = z + 1 '**
added in the rage AC1:AL1
Next i

'and save it in the buffer
z = 1 '**
added
combins = combins + 1
Range("AI9").Value = Format(combins / Range("AI7").Value, "00.00%") '**
added

If Range("AN1").Value >= Range("C1").Value Then '**
added ( adds to buffer only if the combination matches the criteria
[combinations, matches, frequency] )
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3) & " > " & Range("AN1").Value '**
added (& " > " & Range("AN1").Value to find out the frequency)
End If

I am not sure if the approach/logic I followed is correct and need
feedback from VBA Experts like you. I have used a combination of VBA
and Excel formulas to fulfil my requirement. Please let me know if it
is correct and whether it can be changed to reduce more time and
improve on efficiency.

Maxi

Maxi wrote:
I am getting errors while submitting a reply and not sure if it went
through. Trying it again and it might appear twice.

I tried a lot but I am not getting a correct solution. I am still
trying to finish this. I would appreciate if you can help me with this.
For you it will be a cake walk.

 

[lexcel]

Mr Maxi,

I tried to follow what you are attempting. Maybe I have some code that
is a bit more efficient and manageable. It is not recursive, not based
on strings and, I think, easily modifiable to your needs.
If you need any further help let me know.

' ======================================================
' The example routine Test() copies the first row to an array
' and creates all possible subsets
' (combinations) of 2,3,4 and 5 out of the complete set.
'

' The routine DoSomethingWith() is called with every generated subset.
' This is routine you can taylor to your needs
' The routine here simply displays combinations on the sheet

Private NextRow As Long

Sub Test()
Dim V() As Variant, SetSize As Integer, i As Integer

SetSize = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim V(1 To SetSize)

For i = 1 To SetSize
V(i) = Cells(1, i).Value
Next i

NextRow = 3
CreateCombinations V, 2, 5

End Sub


Sub CreateCombinations( _
OriginalSet() As Variant, _
MinSubset As Integer, MaxSubset As Integer)

Dim SubSet() As Variant, SubSetIndex As Long
Dim SubSetCount As Integer, Bit As Integer
Dim k As Integer, hBit As Integer
Dim MaxIndex As Long

hBit = UBound(OriginalSet) - 1
ReDim SubSet(1 To UBound(OriginalSet))

MaxIndex = 2 ^ UBound(OriginalSet) - 1
For SubSetIndex = 1 To MaxIndex
SubSetCount = BitCount(SubSetIndex)
If SubSetCount >= MinSubset And SubSetCount <= MaxSubset Then
k = 1
For Bit = 0 To hBit
If 2 ^ Bit And SubSetIndex Then
SubSet(k) = OriginalSet(Bit + 1)
k = k + 1
End If
Next Bit
DoSomethingWith SubSet, SubSetCount
End If
Next SubSetIndex
End Sub


Sub DoSomethingWith(SubSet() As Variant, ItemCount As Integer)
Dim i As Integer
' Taylor this subroutine to do what you want to be done
' with each combination
' (like comparing it to a draw)

For i = 1 To ItemCount
Cells(NextRow, i) = SubSet(i)
Next i
NextRow = NextRow + 1
End Sub



' count the bits in a number
' every bit represents the presence (1) or absence (0) of an item
' so every combination has its own unique number
' by which it can be identified

Function BitCount(ByVal Pattern As Long) As Integer
BitCount = 0
While Pattern
If Pattern And 1 Then BitCount = BitCount + 1
Pattern = Int(Pattern / 2)
Wend
End Function

' =====================================================

 

[Maxi]

I have optimized the file to a great extent. Now It can create
combinations of 10 numbers based on a criteria (repeated atleast twice,
matching all 10 numbers) in 42 minutes on my celeron 800 MHz 256 MD
SDRAM PC. I feel even this is too high and I want to optimize it
further.

Here is the link for the updated file. I have seen your code just now
and will try and later. I will let you know if I have any doubts in
this code.
http://www40.brinkster.com/maxlott/try.htm

Use this criteria:
Combinations : 2 -> cell A2
Matches : 10 -> cell B1
Frequency : 2 -> cell C1

This macro will create combinations of 10 numbers (cell A2) where all
10 numbers (cell B1) will match atleast two times (cell C1)

run the macro DoIt

You can change the line While recs <= Range("B2").Value to While recs
<= 1 if you want to check how it works but this will analyze only the
first draw.

Thank you for looking into my problem.

Maxi

 

[Maxi]

Can you mail the excel file which has this code. I am a little confused
as to how to use it.

my email address is maheshchindarkar <at> gmail <dot> com

 

[Maxi]

confusion clear. I am wondering how this file can create combinations
based on my criteria. Any updates? are you still working on it? did you
download the combinations.xls file that I posted in my previous post

Thank you
Maxi

 

[lexcel]

Hi mr Maxi

I played a little with yor .xls file indeed, I will let you know later.

To use my code:
Open a new workbook
Open the VBA window and insert the code between '===== with copy/paste
Put some numbers in the first row of the worksheet (e.g. 1 2 3 4 5 6 7
8 9 10)
Run Test

This should put all combinations of 2,3,4 and 5 numbers on the sheet.

Lex

 

[Paul Black]

Hi lexcel,

I tried your Code but got an Application-Defined or Object-Defined
Error in ...

DoSomethingWith

.... on Line ...

Cells(NextRow, i) = SubSet(i)

Any Help will be Appreciated.
All the Best.
Paul

 

[Maxi]

Hi! Paul,

If you run the macro after changing the criteria, it will output to the
bottom of the old output. If you don't want that then, change the row =
line to row = 1. If you do so, it will keep overwriting new results to
the old one therefore I suggest that if you want to change the
criteria, copy the old results somewhere and clear them.

Regarding your latest DoSomethingWith query, I have no idea. Lex's code
works fine for me.

Maxi

 

[Paul Black]

Hi Maxi,

I Run lexcels Code again and it Worked Fine, Weird!.

Thanks for your Help.
All the Best.
Paul

 

[Paul Black]

Hi Maxi & lexcel,

It seems that you both have a knowledge of the Lotto and the concept of
producing Combinations.
I would be VERY grateful if you could both look through the below
thread ...

http://groups.google.com/group/sci....?lnk=gst&q=paul+black&rnum=3#61b445a1368209ce

.... and maybe provide me with some feedback and help on how this can be
achieved please. I have posted this query in several threads and in
several groups, but unfortunately to NO avail.

Any Help will be GREATLY Appreciated.
Thanks in Advance.
All the Best.
Paul

 

[Paul Black]

Hi Maxi & lexcel,

It seems that you both have a knowledge of the Lotto and the concept of
producing Combinations.
I would be VERY grateful if you could both look through the below
thread ...

http://groups.google.com/group/sci....?lnk=gst&q=paul+black&rnum=3#61b445a1368209ce

.... and maybe provide me with some feedback and help on how this can be
achieved please. I have posted this query in several threads and in
several groups, but unfortunately to NO avail.
Perhaps we can keep the replies to this in this group and thread.

Any Help will be GREATLY Appreciated.
Thanks in Advance.
All the Best.
Paul