Looking to improve efficiency of code

DonEB

Board Regular
Joined
Apr 26, 2016
Messages
77
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\ColumnBCDEFGHI
    36181729etc
    4DumboFlairEldersNailetc
    56Dumbo0.0001.5.5.5etc
    618Flair0.071429.510etc
    717Elders0.071429.510etc
    829Nail0.071429.500etc
    9etcetcetcetcetcetcetc

    <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\ColumnGHIJKL
    761817291.5etc
    861817131.5etc
    961817211.5etc
    1061817221.5etc
    1161817261.5etc
    12etcetcetcetcetcetc

    <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
 

StephenCrump

Well-known Member
Joined
Sep 18, 2013
Messages
3,823
Office Version
  1. 365
Platform
  1. Windows
In other subroutines, I was setting cRange = Sheets("CommonData").Range("E5:X24").Value2. However, when I do this, then I get a "Run-Time Error '13'; Type Mismatch.

When you say setting, do you mean:
VBA Code:
Dim cRange As Variant
'...
Set cRange = Sheets("CommonData").Range("E5:X24").Value2
'This will give you a type mismatch error.

You use Set for objects. So you could do something like:
Code:
Dim MyRange As Range
'...
Set MyRange = Sheets("CommonData").Range("E5:X24")
'...
'Do things with the MyRange object

But to pass the values of a range into a variant array, you need:
Code:
Dim cRange As Variant
'...
cRange = Sheets("CommonData").Range("E5:X24").Value2

If that's not the problem, perhaps you could post your code and confirm the line giving you the error message?
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

DonEB

Board Regular
Joined
Apr 26, 2016
Messages
77
When you say setting, do you mean:
VBA Code:
Dim cRange As Variant
'...
Set cRange = Sheets("CommonData").Range("E5:X24").Value2
'This will give you a type mismatch error.

You use Set for objects. So you could do something like:
Code:
Dim MyRange As Range
'...
Set MyRange = Sheets("CommonData").Range("E5:X24")
'...
'Do things with the MyRange object

But to pass the values of a range into a variant array, you need:
Code:
Dim cRange As Variant
'...
cRange = Sheets("CommonData").Range("E5:X24").Value2

If that's not the problem, perhaps you could post your code and confirm the line giving you the error message?
Yes... I'm trying to pass the values of a range from one subroutine to another.
In a subroutine called TeamSelection(), I have set the following:

Dim cRange As Variant
cRange = Sheets("CommonData").Range("E5:X24").Value2

These occur just before calling the subroutine you created and I call PlayerCombo().

In PlayerCombo, I added the following code:

'''''''''''''''''''''''''''''''
' This is what inarray was originally set to in your code
'''''''''''''''''''''''''''''''
' inarray = Sheets("CommonData").Range("E5:X24").Value2

' I added the following within the subroutine just to validate that it was going to accept the variable.
' and it did.
'Dim cRange As Variant
'cRange = Sheets("CommonData").Range("E5:X24").Value2

' This is where I am attempting to set the variable inarray to my "range" This range will change as I move from one
' court to the next.
inarray = cRange

For i = 1 To UBound(lCombinations)
For j = 1 To UBound(lPairs)
dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2))) '<===== This is the line that gets highlighted
Next j
For j = 1 To r
lNumbers(i, j) = NameList(1, lCombinations(i, j))
Next j
Next i


I note above which line gets highlighted and where I get the message saying Run-time error'13': Type mismatch.

Not sure what I'm missing...
 

StephenCrump

Well-known Member
Joined
Sep 18, 2013
Messages
3,823
Office Version
  1. 365
Platform
  1. Windows
dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2))) '<===== This is the line that gets highlighted

I get the message saying Run-time error'13': Type mismatch.

You should be able to debug the problem fairly easily.

When the code breaks, what is the inarray value? You should see it if you hover the cursor over the word: inarray?

Perhaps you have an error value, or a text value? Both will cause a type mismatch if you try to assign to a variable dScores declared as Double.
 

DonEB

Board Regular
Joined
Apr 26, 2016
Messages
77
I attempted to debug as you have taught me. When I hover over the word "inarray" it show a Type mismatch. I've uploaded a screen print to box for you to see. When I hover over any other portion of the code, I do not see any erroneous values being displayed. So... this is not telling me too much.

In the screen print, you will see (or not see) that cRange is being defined. I have defined that in the subroutine that is initiating the variable. If this is suppose to be done differently, please let me know.

Box

Any other thoughts?
 

StephenCrump

Well-known Member
Joined
Sep 18, 2013
Messages
3,823
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Based on that hover message, It looks like inarray isn't an array. Which implies that cRange also is not an array. Which means there is something wrong with the way cRange is being populated. Which I can't see.

Can you post all your code, thanks.
 

DonEB

Board Regular
Joined
Apr 26, 2016
Messages
77
I am providing the code from the two primary subroutines involved. The code you developed ( and I call PlayerCombo) and my subroutine called TeamSelection. I've saved them in a WORD document.... not sure what I was suppose to use.

Subroutines

Within TeamSelection I have defined cRange As Variant and then I initialize it with the Sheets reference. Later in that code I call Player Combo. I've highlighted all this in yellow for easy reference.

And you already have the error message I got when trying to run the macro which includes these subroutines.

But here's what really gets me... in the PlayerCombo sub routine, right above the inarray = cRange code, you will see that I have comment out and made reference to some "Testing" code. Before I tried to place the code in TeamSelection, I first placed it directly above the inarray = cRange code. And this worked successfully. Only when I placed the same code in the TeamSelection subroutine did I get the error message.
So... this is where I struggle to find the answer to the problem. Thanks for your assistance once again.
 

StephenCrump

Well-known Member
Joined
Sep 18, 2013
Messages
3,823
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

In break mode, hover on this line:

inarray = cRange

and you'll see that both are Empty. Why is that?

You have declared cRange as Variant in Sub TeamSelection, so cRange is local to that Sub. So when you refer to cRange in Sub PlayerCombo, it is Empty.

I strongly recommend you always use Option Explicit in your coding (Google it to see why). If you had used Option Explicit, then VBA would have given you a Compile error: Variable not defined error message for cRange in Sub PlayerCombo. That would have saved you a lot of debug time!
 

DonEB

Board Regular
Joined
Apr 26, 2016
Messages
77
Yes... I can see how that would have saved me some time. Learning something new every day.

I read where the Option Explicit had to appear in a file before any other source code statements. So, I've placed it in Module 1 as the first item before I defined any Public variables. I have also defined a public variable in Module 1 called cRange as follows: Public cRange As Variant.

I also removed defining cRange as a local variable from the TeamSelection subroutine, however, I still set cRange = Sheets("CommonData").Range("E5:X24").Value2

When I run the program.... and stop at break point over the line inarray = cRange, continues to be empty.
 

DonEB

Board Regular
Joined
Apr 26, 2016
Messages
77
Not sure why that last message was sent 30 minutes ago I tried to updated it with this one but the time limit of 10 minutes got me. However, I do have a problem that involves the code you provided but have not been able to determine the cause.

Issue:
  1. I was attempting to validate all the calculations that were performed by your code but, as you have noted, with so many numbers... it becomes nearly an impossible task.
  2. As a result, I decided to simplify the testing and tried to apply all the same logic to just one court using 6 the SAME people.
  3. As I initiate the process, I am able to successfully create assignments of 4 people to courts1 for weeks 1, 2, 3 and 4
  4. Upon getting to week 5 something goes wrong.
  5. I am able to determine that your code (sub PlayerCombo) is accessed
  6. However, once completed, PlayerCombo does not write any information to my worksheet Courts1.
  7. Using the hovering technique, I am able to determine that values are in fact present for Combinations and Namelist when hovering over "dScores(i, j) = inarray(lCombinations(i, lPairs(j, 1)), lCombinations(i, lPairs(j, 2)))" and "lNumbers(i, j) = NameList(1, lCombinations(i, j))"
  8. So, it appears that the program gets into your program, but does not write the results to designated worksheet "Courts1". And, again, it worked successfully for the 4 weeks preceeding this one using the exact same data for input.
In the event you were inclined to take a look at it, I have decided to provide the following link to the entire worksheet. As you already know, I'm far less than a seasoned programmer thus my reluctance to share this in the past. I was just embarrassed by how archaic my attempt a coding might be versus how advanced and proficient your knowledge about coding is.

Here's the link in case you are interested. TennisDoublesQuarterlySchedule
Note: I discovered that you can't run a subroutine thru the spreadsheet while the TOGGLE BREAKPOINT is on. So, to be able to perform the tasks for different weeks you need to go to AllWeeks(B1) and change that number to the week you wish to run the program for. If you go in and look at that value, it is likely set to 5... meaning week 5. To make it run for week 4, just change that number to 4.

If not... if you have any thoughts or suggestions as to what the cause might be... I'll be all ears.

Thanks,
Don
 

Watch MrExcel Video

Forum statistics

Threads
1,114,002
Messages
5,545,441
Members
410,684
Latest member
LakTik
Top