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/micro...4a5d06ae786d57

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/micro...4a5d06ae786d57

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.

--
Regards,
Tom Ogilvy


"Maxi" wrote:

> 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/micro...4a5d06ae786d57
>
> 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/micro...4a5d06ae786d57
>
> Many Thanks
> Maxi
>
>

[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/micro...4a5d06ae786d57

Thanks
Maxi

Tom Ogilvy wrote:

> will generate the combinations of which you speak.
>
> --
> Regards,
> Tom Ogilvy

[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 wrote:
> 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.

[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

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,

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.