Looking to improve efficiency of code

DonEB · Oct 30, 2019

The following code was taken from a macro I have been working on .... most of which is due to the help of people within this Forum... so thank you. Unfortunately, it takes over 60 seconds to run. I can't blame those who helped me in the past because I never conveyed the entire scope of the project and was just looking to learn some macro tricks with the hopes that it may solve my problem. Since this code only reflects one part of the overall task that needs to be done, finding a faster way to complete this task is essential.

So, the question is... is there a more efficient way to perform the task I'm performing below using VBA within Excel? Any thoughts on how to reduce processing time would be appreciated. Since there are generally 13 weeks in a quarter, this process has to be run 13 times... so that means it would take a minimum of 13 minutes to run. That's not good.

A little background...

This program is being created to assign the "best combination" of 4 players to a tennis court and there could be as many as 5 courts to be filled on any one day.
Best combination means "those 4 players who have played the least amongst themselves. This "value" is determined as assignments are made to the quarterly schedule. Example: If 2 weeks of play have been completed and player 1 and player 2 have already played against/with each other once then their respective values would be 1 day of play/2 weeks or .50.
With 5 courts, that would equate to as many as 20 players at one time (4 for each court). In my spreadsheet, I am able to whittle the players down to a top 20 players. When determining how many "combinations" exist for 20 players taken 4 at a time, that equates to 4845.
Sheets("CommonData").Range("B3:X24") refers to a chart consisting of 22 rows and 23 columns.
Example of this data is in the Chart below: This is just a snippet... last names are in the second column and second row. And the chart extends to the right and down until a total of 20 players are reflected.

Row\Column B C D E F G H I
3 6 18 17 29 etc
4 Dumbo Flair Elders Nail etc
5 6 Dumbo 0.0001 .5 .5 .5 etc
6 18 Flair 0.071429 .5 1 0 etc
7 17 Elders 0.071429 .5 1 0 etc
8 29 Nail 0.071429 .5 0 0 etc
9 etc etc etc etc etc etc etc

<tbody>
</tbody>
players = Range("G7:K4851") refers to a chart consisting of 4845 rows and 6 columns.
Example of this data is in the Chart below: This is just a snippet... but the first 4 columns consist of four potential players to be assigned to a court. The fifth column reflects the "value" as determined by the code below. Value between 6 and 18 is .5, between 6 and 17 is .5 and between 6 and 29 is .5 for a total of 1.5.
Later in the program (not in the code below) this chart is sorted to bring the lowest value in the 5th column to the top. Those would be the best candidates to place on the first court.
Row\Column G H I J K L
7 6 18 17 29 1.5 etc
8 6 18 17 13 1.5 etc
9 6 18 17 21 1.5 etc
10 6 18 17 22 1.5 etc
11 6 18 17 26 1.5 etc
12 etc etc etc etc etc etc

<tbody>
</tbody>

Here's the code:

Dim Courts5(4845, 6) As Variant 'defines array as being 4845 rows, 6 columns
Dim X As Long
Dim Y As Long

Dim i As Long
Dim j As Long

Dim Total As Variant

inarr = Sheets("CommonData").Range("B3:X24") ' move this outside the loop so that it only executes once

'load all the players data
Sheets("Courts5").Select
players = Range("G7:K4851")

For X = 1 To 4845 Step 1 ' Step thru each row
Total = 0
For Y = 2 To 4 Step 1 ' For each row, step thru each column starting with the second column

VB2 = players(X, Y)
VA2 = players(X, 1) ' Player in 1st column for which the values are being computed.
For i = 1 To 23
If inarr(1, i) = VB2 Then
Exit For ' we have found the column
End If
Next i
For j = 1 To 23
If inarr(j, 1) = VA2 Then
Exit For ' we have found the row
End If
Next j

Courts5(X, Y) = inarr(j, i) 'placing value found using "lookup" in the 5th position of the same array to be used in the future
Total = Total + Courts5(X, Y) 'placing value found using "lookup" in the 5th position of the same array to be used in the future

Next Y

Cells(6 + X, 11).Value = Total 'write computed total to appropriate place within the table
Next X

DonEB · Nov 3, 2019

StephenCrump .... I used the code and all I can say is PERFECT!!

Thank you very much!! I can't begin to express how great full I am with all that you have done and provided. I'm still going to try my best to understand the code you used and how it works. It's amazing how much more efficient your code has made my excel spreadsheet program. Again, thank you!

DonEB · Nov 5, 2019

Your code works perfectly for when I have 20 potential players and I'm trying to fill one court. But, as I fill one court, I take those players I used off the list which creates a new set of combination of players. So... my question is, might it be possible to pass specific variables/parameters to your code making it dynamic enough to handle 1, 2, 3,4 or 5 courts?

When looking at your code, there are three specific references I would like to be able to pass variables to... but I'm not sure if that will work or how to accomplish that. I think that's where global variables come into play.. but you can correct me on that if I'm wrong.

Specifically, your code refers to the following:

N=20
1. I know that this refers to the number of players available use and is the basis upon which the list of combinations is created.
2. Question: Can this be made to accept a variable so that whether I need to fill 5 courts or just 1, I can pass it the proper number to which the list of combinations will be created?
NameList = Range("MyNumbers").Value2
1. My real range is = Sheets("CommonData").Range("$E$3:$X$3").Value2
2. This corresponds to the list of 20 player numbers that are at the top of a table
3. Question: Can this be made to accept a variable so that as the number of available players are adjusted either because they are being used to play on another court OR there is simply fewer players to select from, I would like to be able to pass to your code a proper number to which the list of combinations will be created for the next round of determining the best option for players?
inarray = Sheets("CommonData").Range("E5:X24").Value2
1. This corresponds to a table of computations reflecting % of time played between the list of 20 player numbers being referenced to by NameList
2. Question: Can this be made to accept a variable so that as the number of available players are adjusted either because they are being used to play on another court OR there is simply fewer players to select from, I would like to be able to pass to your code a proper "range" to reflect the computations associated with the whatever number of players I will be using.

In my program, I know I will be either using 20 players, 16, 12, 8, or 4. And as those numbers change, so to would the ranges within the other variables.

The alternative is for me to simply take your program and copy it 4 times and establish fixed the parameters within them. But I would prefer to use only one program and pass it the variables of that is doable. This way if any future changes are required to your code then I will only have to make those changes in one spot.

Whichever way you feel is the best approach... I will go with. If making copies is the best approach.... I'm fairly confident I can handle that. If keeping your code and passing it variables is the best approach then I would need some guidance as to how to accomplish that because my efforts have failed and I'm not sure why.

Thanks,
Don

StephenCrump · Nov 5, 2019

DonEB said:
The alternative is for me to simply take your program and copy it 4 times and establish fixed the parameters within them. But I would prefer to use only one program and pass it the variables of that is doable.

I agree. It would be much better to parameterise.

Have a think about the best way to do this. For example, you could pass N = 20 from Excel to VBA via a particular cell, or better still, a named range.

You could pass all the input data (i.e. player names, numbers, paired scores) via a single named range. Alternatively, pass a single cell reference (perhaps something like .Range("StartHere") for the top left hand cell) and let VBA determine the number of rows/columns.

Given you are iterating 20, 16, 12, 8 players (with 4 presumably being those remaining), perhaps a better approach would be to preserve the data table with 20 players (i.e. rather than rearranging your data after each successive selection of four players) and having a row of simple TRUE/FALSE flags, to indicate whether the player is to be included in the iteration. You start with all TRUE for the first iteration, set to FALSE for the first four players selected then re-run, etc.

You might then want to pass a sheet name from Excel to VBA, so that the results of each iteration could be dumped to different worksheets? Potentially the code could then also generate your evaluation formulae into the right cells for each worksheet.

DonEB said:
If keeping your code and passing it variables is the best approach then I would need some guidance as to how to accomplish that because my efforts have failed and I'm not sure why.

How are you passing parameters? Can you post some code to illustrate?

DonEB · Nov 6, 2019

Your blowing my mind with the various options your throwing at me... very interesting to say the least. To answer you last question, let me share with you the following. The code you provided contained the following three variables that I would need to pass in order for the same code to work with multiple combinations. They are... N, NameList and inarray

I was able to successfully get the first two variables to work by establishing new public variables and using them to pass values from one subroutine to another. Examples:

Public nPlayers as Long was created and was used to feed into your variable N
Public myNameList as Variant was created and was used to feed into your variable NameList

I did however run into a problem trying to feed your variable called inarray.

I established the following: Public myinarray as Variant
In my subroutine called Sub TeamSelection(), I set the variable myinarray = Sheets("CommonData").Range("E5:X24").Value2
Then in your subroutine called Sub PlayerCombo5(), I set the variable inarray = myinarray

This resulted in a ERROR. The message I got was Run-Time Error ‘13’: Type mismatch. And the code it was referencing was...
dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2)))

And... that's where I got stuck. Where did I go wrong?

I'll try to digest your other ideas and get back to you on those.

DonEB · Nov 6, 2019

I'm going to try and address the ideas you presented in your last response.

You Stated: Have a think about the best way to do this. For example, you could pass N = 20 from Excel to VBA via a particular cell, or better still, a named range.
1. I actually have this information and can grab it from a cell already. The cell reference is Worksheet "AllWeeks" and cell E79
You Stated: You could pass all the input data (i.e. player names, numbers, paired scores) via a single named range. Alternatively, pass a single cell reference (perhaps something like .Range("StartHere") for the top left hand cell) and let VBA determine the number of rows/columns.
1. If this is referring to the table containing the player data (discussed below) then if I keep the entire table reflecting the 20 people then this would not be an issue... did I understand that correctly?
You Stated: Given you are iterating 20, 16, 12, 8 players (with 4 presumably being those remaining), perhaps a better approach would be to preserve the data table with 20 players (i.e. rather than rearranging your data after each successive selection of four players) and having a row of simple TRUE/FALSE flags, to indicate whether the player is to be included in the iteration. You start with all TRUE for the first iteration, set to FALSE for the first four players selected then re-run, etc.
1. I currently am preserving the data table with 20 players and the numbers that reflect % of play with the other players.
2. I do go thru a process of removing players from the next iteration but it is cumbersome. Once I determine the remaining set of player numbers, I take them and establish a new combination of numbers to work with, and so on.
3. Let me give you a very small example of the process I currently go thru so you can understand the overall problem I am working with. My current system works fine for determining 3 courts (max 12 people) but going beyond that results in a massive amount of time to compute the schedule.

Assuming 12 people to assign to 3 courts
STEP 1: Using the 12 people, I go thru my first iteration of finding the best combination of 4 people by examining their "score", then remove those 4 from the list of available players. Of course, the best combination has been sorted to the top of the list.
STEP 2: Using the remaining 8 people, I go thru my second iteration of finding the best combination of 4 people by examining their "score", then remove those 4 from the list of available players
STEP 3: That leaves me with 4 people and all I do is determine their score.
But I don't stop there. I look at the total score of all three group... put all that information aside then go through the entire process again beginning with the next group found in STEP 1.
I do this because even though the scores of the first group may be great, if the scores of the third group reflect that these players have already played each other the max number of times then I prefer to look for a better combination.
Bottom line, while I look at each group separately, I have to look at the cumulative totals of all three groups too.

I hope that makes sense.

StephenCrump · Nov 6, 2019

DonEB said:
I did however run into a problem trying to feed your variable called inarray.

I established the following: Public myinarray as Variant

In my subroutine called Sub TeamSelection(), I set the variable myinarray = Sheets("CommonData").Range("E5:X24").Value2

Then in your subroutine called Sub PlayerCombo5(), I set the variable inarray = myinarray

This resulted in a ERROR. The message I got was Run-Time Error ‘13’: Type mismatch. And the code it was referencing was...
dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2)))

The problem wasn't in setting inarray = myinarray.

The type mismatch probably means you have non-numeric values somewhere in myinarray/inarray. Because dScores has been declared as type Double, it can't accept text values.

But in any event, you can pass arguments directly to a Sub or Function, e.g. look at how I call my function GetCombinations.

StephenCrump · Nov 6, 2019

DonEB said:
Let me give you a very small example of the process I currently go thru so you can understand the overall problem I am working with. My current system works fine for determining 3 courts (max 12 people) but going beyond that results in a massive amount of time to compute the schedule.

Assuming 12 people to assign to 3 courts

STEP 1: Using the 12 people, I go thru my first iteration of finding the best combination of 4 people by examining their "score", then remove those 4 from the list of available players. Of course, the best combination has been sorted to the top of the list.

STEP 2: Using the remaining 8 people, I go thru my second iteration of finding the best combination of 4 people by examining their "score", then remove those 4 from the list of available players

STEP 3: That leaves me with 4 people and all I do is determine their score.

But I don't stop there. I look at the total score of all three group... put all that information aside then go through the entire process again beginning with the next group found in STEP 1.

I do this because even though the scores of the first group may be great, if the scores of the third group reflect that these players have already played each other the max number of times then I prefer to look for a better combination.

Bottom line, while I look at each group separately, I have to look at the cumulative totals of all three groups too.

Yes, I can see how this gets cumbersome. On further thought, I'd approach the problem in a different way.

With only 12 people, the analysis is easy. There are only 5,775 combinations (12!/(3! x (4!)^3) and you can easily dump and test all these in a worksheet.
There's some code in Post #27 here (thanks pgc01) that will enumerate the combinations: https://www.mrexcel.com/forum/excel...ble-unique-combinations-groups-numbers-3.html

For 16 people, there are approximately 2.6 million combinations, too big to dump into Excel but easy enough to test all possible combinations in VBA.

But for 20 people, we hit approximately 2.5 billion, so it's impractical to adopt a brute-force test-all-combinations approach. But I can think of a few ways to make the number more manageable. One way might be to fill the first court - only Combin(20,4) combinations to be tested, and perhaps we pick a middling score (i.e. rather than selecting the optimum combination which makes it more likely that other courts have players who have played each other every week). Then we can brute-force test all 2.6 million combinations for the other four courts. I'd envisage this only taking a minute or two to run.

DonEB · Nov 6, 2019

StephenCrump said:
The problem wasn't in setting inarray = myinarray.

The type mismatch probably means you have non-numeric values somewhere in myinarray/inarray. Because dScores has been declared as type Double, it can't accept text values.

But in any event, you can pass arguments directly to a Sub or Function, e.g. look at how I call my function GetCombinations.

That's interesting because in your code you had the following: inarray = Sheets("CommonData").Range("E5:X23").Value2. I had to change the range reference to "E5:X24" because that's actually the size of the table.

Then all I did was create my own variable called myinarray and set that equal to the same = Sheets("CommonData").Range("E5:X24").Value2 and then passed that variable onto your code.

So... I don't understand why it works when the same "range" is used within your code but does not work when it is passed to your code via my variable myinarray.

I tested it out this way on purpose to try and avoid making too many changes at once. And, it would allow me to verify the information is the same.

Do you understand my confusion? You say that I have a non-numeric value somewhere in myinarray/inarray but then why does the same range work when it is used directly within your code?

StephenCrump · Nov 6, 2019

DonEB said:
You say that I have a non-numeric value somewhere in myinarray/inarray but then why does the same range work when it is used directly within your code?

If you're happy to post your workbook (?) it should take only a few seconds to diagnose the type mismatch.

Otherwise without seeing your layout and the rest of your code I can only speculate about what's happening. I could easily have it wrong!

DonEB · Nov 6, 2019

StephenCrump said:
Yes, I can see how this gets cumbersome. On further thought, I'd approach the problem in a different way.

With only 12 people, the analysis is easy. There are only 5,775 combinations (12!/(3! x (4!)^3) and you can easily dump and test all these in a worksheet.
There's some code in Post #27 here (thanks pgc01) that will enumerate the combinations: https://www.mrexcel.com/forum/excel...ble-unique-combinations-groups-numbers-3.html

For 16 people, there are approximately 2.6 million combinations, too big to dump into Excel but easy enough to test all possible combinations in VBA.

But for 20 people, we hit approximately 2.5 billion, so it's impractical to adopt a brute-force test-all-combinations approach. But I can think of a few ways to make the number more manageable. One way might be to fill the first court - only Combin(20,4) combinations to be tested, and perhaps we pick a middling score (i.e. rather than selecting the optimum combination which makes it more likely that other courts have players who have played each other every week). Then we can brute-force test all 2.6 million combinations for the other four courts. I'd envisage this only taking a minute or two to run.

I was sitting here watching some TV when I realized I failed to mention in my note that I DO NOT go thru all combinations. You are absolutely correct... the way I had written the macros would not have allow it to run very fast.... even for just 3 courts.

Actually, for three courts.... I was only looking at the top 15 combinations for court 1, then the top 10 combinations for court 2, and that would just leave me with the single combination for court 3.

So, for trying to make this work for 5 courts, I think I was going to simply look at the top 50 combinations for court 1, top 30 for court 2, top 20 for court 3, top 10 for court 2 and then we would have the single combination for court 5. But even for this number of combinations... it was way too much for my computer to handle. However, your code proved to be much more efficient and faster. Now... if I can only figure out the problem why passing the range reference using the variable myinarray doesn't work but does work when using your inarray directly within your code.

But I will take a look at the information you referred to in your response and I'll see what I can get out of it. Thanks for sharing.

Looking to improve efficiency of code

DonEB

Board Regular

DonEB

Board Regular

Excel Facts

DonEB

Board Regular

StephenCrump

MrExcel MVP

DonEB

Board Regular

DonEB

Board Regular

StephenCrump

MrExcel MVP

StephenCrump

MrExcel MVP

DonEB

Board Regular

StephenCrump

MrExcel MVP

DonEB

Board Regular

Similar threads

Forum statistics

Share this page

Row\Column	B	C	D	E	F	G	H	I
3				6	18	17	29	etc
4				Dumbo	Flair	Elders	Nail	etc
5	6	Dumbo	0.0001		.5	.5	.5	etc
6	18	Flair	0.071429	.5		1	0	etc
7	17	Elders	0.071429	.5	1		0	etc
8	29	Nail	0.071429	.5	0	0		etc
9	etc	etc	etc	etc	etc	etc	etc

Looking to improve efficiency of code

Board Regular

Board Regular

Excel Facts

Board Regular

MrExcel MVP

Board Regular

Board Regular

MrExcel MVP

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock