Looking to improve efficiency of code

[DonEB]

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.
  [TABLE="class: grid, width: 500"]
  <tbody>[TR]
  [TD]Row\Column[/TD]
  [TD]B[/TD]
  [TD]C[/TD]
  [TD]D[/TD]
  [TD]E[/TD]
  [TD]F[/TD]
  [TD]G[/TD]
  [TD]H[/TD]
  [TD]I[/TD]
  [/TR]
  [TR]
  [TD]3[/TD]
  [TD][/TD]
  [TD][/TD]
  [TD][/TD]
  [TD]6[/TD]
  [TD]18[/TD]
  [TD]17[/TD]
  [TD]29[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]4[/TD]
  [TD][/TD]
  [TD][/TD]
  [TD][/TD]
  [TD]Dumbo[/TD]
  [TD]Flair[/TD]
  [TD]Elders[/TD]
  [TD]Nail[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]5[/TD]
  [TD]6[/TD]
  [TD]Dumbo[/TD]
  [TD]0.0001[/TD]
  [TD][/TD]
  [TD].5[/TD]
  [TD].5[/TD]
  [TD].5[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]6[/TD]
  [TD]18[/TD]
  [TD]Flair[/TD]
  [TD]0.071429[/TD]
  [TD].5[/TD]
  [TD][/TD]
  [TD]1[/TD]
  [TD]0[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]7[/TD]
  [TD]17[/TD]
  [TD]Elders[/TD]
  [TD]0.071429[/TD]
  [TD].5[/TD]
  [TD]1[/TD]
  [TD][/TD]
  [TD]0[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]8[/TD]
  [TD]29[/TD]
  [TD]Nail[/TD]
  [TD]0.071429[/TD]
  [TD].5[/TD]
  [TD]0[/TD]
  [TD]0[/TD]
  [TD][/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]9[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD][/TD]
  [/TR]
  </tbody>[/TABLE]
• 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.
• [TABLE="class: grid, width: 500"]
  <tbody>[TR]
  [TD]Row\Column[/TD]
  [TD]G[/TD]
  [TD]H[/TD]
  [TD]I[/TD]
  [TD]J[/TD]
  [TD]K[/TD]
  [TD]L[/TD]
  [/TR]
  [TR]
  [TD]7[/TD]
  [TD]6[/TD]
  [TD]18[/TD]
  [TD]17[/TD]
  [TD]29[/TD]
  [TD]1.5[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]8[/TD]
  [TD]6[/TD]
  [TD]18[/TD]
  [TD]17[/TD]
  [TD]13[/TD]
  [TD]1.5[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]9[/TD]
  [TD]6[/TD]
  [TD]18[/TD]
  [TD]17[/TD]
  [TD]21[/TD]
  [TD]1.5[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]10[/TD]
  [TD]6[/TD]
  [TD]18[/TD]
  [TD]17[/TD]
  [TD]22[/TD]
  [TD]1.5[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]11[/TD]
  [TD]6[/TD]
  [TD]18[/TD]
  [TD]17[/TD]
  [TD]26[/TD]
  [TD]1.5[/TD]
  [TD]etc[/TD]
  [/TR]
  [TR]
  [TD]12[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [TD]etc[/TD]
  [/TR]
  </tbody>[/TABLE]

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]

I was preparing to send you a stripped down version of the workbook. And as I was testing the code to verify the error still exist... to my surprise it worked!!! Not sure why... I'm using the exact same data. I simply copied from one workbook to another.

I'm going to have to re-examine the code to see what I must have done wrong.

As soon as I figure that particular issue out... I will be able to take the next major step in revamping this program. Once again... thank you for all your help. From where I'm standing... it was priceless.

 

[DonEB]

Stephen.... here is a link to a stripped down version of my project. It will contain only two worksheets and only one subroutine... your code and some misc stuff. Let me know if the link worked.
Code Not Summing Correctly

• Worksheet("Courts1) - the worksheet that receives the information from your subroutine
• Worksheet("CommonData") - the worksheet that contains the data the your subroutine uses to populate Worksheet("Courts1")
• PlayerCombo - the subroutine you provided

I would first bring your attention to the CommonData worksheet.

1. Down the left column "B", locate players 2, 3 and 4.
2. Look at the combinations here 2 & 3, 2 & 4, 3 & 4 and the notice the results
3. Example: Column B find 2 (at B5) and look across Row 3 until you find player number 3 (at M3). You will notice that there is a 1 in the M5 cell.
4. The same will be true for the other two combinations above.
5. Then go to macros and run the PlayerCombo subroutine
6. I would like you to find the following results: players 5 - 2 - 4 - 3 by sorting column C by ascending order
7. When you find the above series of numbers... you should find that there are all zeros on the fields where I would expect to see at a few 1's.

If I messed something up... I would appreciate you shedding some light on this for me. If there is something in the code.... then I know I would not be able to tweak it to make it work.

Thanks for taking the time to review this for me.

Don

 

[StephenCrump]

Maybe it's time to dig into the code, understand what it does?

Try (in a junk copy of your workbook):
- putting some random numbers into CommonData!E5:X24 (perhaps =RANDBETWEEN(1,200) and copy/paste values so there are likely to be few duplicates)
- putting a breakpoint on the bold line below, and stepping through the first six iterations

inarray = Sheets("CommonData").Range("E5:X24").Value2

For i = 1 To UBound(lCombinations)
    For j = 1 To UBound(lPairs)
[B]       dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2)))[/B]
    Next j

- testing the values of lPairs, lCombinations and dScores at each iteration.

This is the first combination, i.e. 1,2,3,4 (out of the Combin(20,4) combinations 1,2,3,4 | 1,2,3,5 | ... 17,18,19,20)
and the six iterations test the six pairs 1-2, 1-3, 1-4, 2-3, 2-4 and 3-4

Where (in inarray) is the code expecting to find the values for dScores? I gave you a clue in Post #2:

Your code does a lot of looping through rows and columns, because you are trying to locate player numbers, e.g. 6, 18, 17 and 29 for the first combination. If you think instead of this first combination as 1,2,3,4, the second as 1,2,3,5 ... and the 4,845th as 17,18,19,20, then you can work direct with these numbers as row and column numbers.

Do see why your layout is the problem?

 

[StephenCrump]

This is the bold line:

dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2)))

Maybe this new Forum doesn't let you change fonts inside code tags?

 

[DonEB]

Oh... my apologies. I misunderstood and thought the code already returned the combinations back to the actual values since "NameList" references those player numbers. So I may understand, what is NameList used for?

At the risk of asking too much of you, if you look at that chart in CommonData, you'll notice that I do have numbers 1 - 20 in E2:X2 and the actual players numbers are in E3:X3. The only way I know how to convert the numbers generated from your code back to the actual player numbers is by using a lookup. However, my guess is that there is a much more efficient way of handling this. Might you have one more suggestion for that?

I appreciate you helping understand what is happening within the code you provided.

Don

 

[DonEB]

Maybe it's time to dig into the code, understand what it does?

Try (in a junk copy of your workbook):
- putting some random numbers into CommonData!E5:X24 (perhaps =RANDBETWEEN(1,200) and copy/paste values so there are likely to be few duplicates)
- putting a breakpoint on the bold line below, and stepping through the first six iterations

inarray = Sheets("CommonData").Range("E5:X24").Value2

For i = 1 To UBound(lCombinations)
    For j = 1 To UBound(lPairs)
[B]       dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2)))[/B]
    Next j

- testing the values of lPairs, lCombinations and dScores at each iteration.

This is the first combination, i.e. 1,2,3,4 (out of the Combin(20,4) combinations 1,2,3,4 | 1,2,3,5 | ... 17,18,19,20)
and the six iterations test the six pairs 1-2, 1-3, 1-4, 2-3, 2-4 and 3-4

Where (in inarray) is the code expecting to find the values for dScores? I gave you a clue in Post #2:

Your code does a lot of looping through rows and columns, because you are trying to locate player numbers, e.g. 6, 18, 17 and 29 for the first combination. If you think instead of this first combination as 1,2,3,4, the second as 1,2,3,5 ... and the 4,845th as 17,18,19,20, then you can work direct with these numbers as row and column numbers.

Do see why your layout is the problem?

OK... my mind is exploding so please let me try this again.... I really didn't understand some of what you were asking me to try and do.

I have created the random sample of values as you suggested and I pasted the values in to the chart in CommonData!E5:x24.

I had to look up "breakpoint" to see what that was and how to do it... so I got figured out how to set the breakpoint by placing the cursor to the left side of the line of code and pressing F9. But, I'm not sure how to go about "testing the values of lPairs, lCombinations and dScores at each iteration".

Yes... I understand that the code is in a loop (For i and For j) but I'm not sure how to view the values of IPairs, ICombinations and dScores at each iteration. I would assume any code that would allow me to view the values would be placed right below the "dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2)))" code but that is simply my best guess.

And yes... I would like to try and understand how your code works.

Don

 

[StephenCrump]

Oh... my apologies.

No problem, and no apologies necessary.

And yes... I would like to try and understand how your code works.

Great! You may need to invest a bit of time, but it should give you the confidence to start making changes to the code ...

I suggest you do a bit of Googling - something like How to use the Visual Basic Editor should bring up a range of articles/video clips that you could work through depending on how you like to learn.

You've worked out how to insert a break-point (another way is to put the cursor into a code line and use F9 to toggle on/off, or use the menu Debug/Toggle Breakpoint).

You should also find out about:
- F5 (to run the code up to the next breakpoint)
- F8 or Shift-F8 (to step through the code line by line)
- Using the Immediate Window

For example, if you put in a breakpoint and step through the code using F8, you should be able to hover the cursor over particular terms j, i, lPairs(j, 1), dScores(i, j) and see the VB Editor evaluate these for you?

So I may understand, what is NameList used for?

NameList = Sheets("CommonData").Range("$E$3:$X$3").Value2

This is just a quick way to get the values of a range into a VBA array. NameList is a misnomer - It's actually your player numbers, rather than names, i.e. 14, 15, 19 ,5.

If you put a breakpoint in after this line, you can use the immediate window to see what you've got:
e.g. try
? Ubound(NameList)
? Ubound(NameList,2)

... will let you know you have a 1 x 20 array.
? NameList(1,3)
will return 19.

So if you step through this next bit of code for the first four iterations (i.e. i =1 and j = 1 to 4) you'll see how my first combination (1,2,3,4) is converted to your numbering (14,15,19,5). The results are stored in the first row of the lNumbers array, which is later dumped into Excel for viewing.

r = 4
'...
For i = 1 To UBound(lCombinations)
    '...
    For j = 1 To r
        lNumbers(i, j) = NameList(1, lCombinations(i, j))
    Next j
Next i

 

[DonEB]

No problem, and no apologies necessary.



Great! You may need to invest a bit of time, but it should give you the confidence to start making changes to the code ...

I suggest you do a bit of Googling - something like How to use the Visual Basic Editor should bring up a range of articles/video clips that you could work through depending on how you like to learn.

You've worked out how to insert a break-point (another way is to put the cursor into a code line and use F9 to toggle on/off, or use the menu Debug/Toggle Breakpoint).

You should also find out about:
- F5 (to run the code up to the next breakpoint)
- F8 or Shift-F8 (to step through the code line by line)
- Using the Immediate Window

For example, if you put in a breakpoint and step through the code using F8, you should be able to hover the cursor over particular terms j, i, lPairs(j, 1), dScores(i, j) and see the VB Editor evaluate these for you?



NameList = Sheets("CommonData").Range("$E$3:$X$3").Value2

This is just a quick way to get the values of a range into a VBA array. NameList is a misnomer - It's actually your player numbers, rather than names, i.e. 14, 15, 19 ,5.

If you put a breakpoint in after this line, you can use the immediate window to see what you've got:
e.g. try
? Ubound(NameList)
? Ubound(NameList,2)

... will let you know you have a 1 x 20 array.
? NameList(1,3)
will return 19.

So if you step through this next bit of code for the first four iterations (i.e. i =1 and j = 1 to 4) you'll see how my first combination (1,2,3,4) is converted to your numbering (14,15,19,5). The results are stored in the first row of the lNumbers array, which is later dumped into Excel for viewing.

r = 4
'...
For i = 1 To UBound(lCombinations)
    '...
    For j = 1 To r
        lNumbers(i, j) = NameList(1, lCombinations(i, j))
    Next j
Next i

Stephen... thanks to your persistence and willingness to work with me... I believe I found my problem.

It turns out that the chart that the table that was being referred to when you use this code

inarray = Sheets("CommonData").Range("E5:X24").Value2

was not exactly as you had expected it to be. Let me explain.... while the player numbers in row E3:X3 were used to provide a reference to the above chart were in random order, I had actually sorted the player numbers in an associated column (top to bottom, ascending order) because I was using those numbers to conduct a LOOKUP... and that required them to be sorted.

However, in the code you provided, you performed all the summing for each group of players which took away the requirement for me to do any LOOKUPS... so I was able to get rid of the sort and now the appropriate values are being grouped together and summed. I hope that makes sense to you. But all is good now.

So... once again... thanks for your help and guidance. It was all much appreciated.

Don

 

[StephenCrump]

Great, I am glad you figured it out ...

... and maybe learned a bit of coding in the process.

 

[DonEB]

Great, I am glad you figured it out ...

... and maybe learned a bit of coding in the process.

Stephen.... I have been able to figure out quite a bit now. While I'm beginning to understand how certain code is working, I'm having some difficulty trying to modify the code to make it work when trying to fill all 5 courts. I need to be able to change the "E5:X24" reference below depending on which court I'm working on.

inarray = Sheets("CommonData").Range("E5:X24").Value2

I attempted to create a new public variable called cRange as variant. Then as I progressed down each step, I would reference the appropriate "range" of cells that will be used by your code to perform the proper summing of the values found within that chart. In other subroutines, I was setting cRange = Sheets("CommonData").Range("E5:X24").Value2 or cRange = Sheets("CommonData").Range("AS5:BH2024").Value2, etc. However, when I do this, then I get a "Run-Time Error '13'; Type Mismatch.

This confuses me a little since you defined inarray as variant and I defined Public cRange as variant.

I'm sure it is something simple... but even though I tried to google this... I must be asking the wrong question. Any thoughts? I think once I get this linked up properly then all the values I'm expecting to be summed... will be correct.

Thanks,
Don