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...
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
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]
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