Hello group!
A couple of weeks ago, Bob Phillips helped me with a function that
rearranges and sorts my list of run times (for different courses when I've
been out running). Now, I'm just wondering, is such a function supposed to
take 3-4 minutes to execute (on a slow, 800MHz/384RAM (not the newer, faster
type))?
For each course that I've run (currently about 15 in the "course list"), the
function runs through my list of runs (which consists of results from about
90 runs) so that the script can make a new listing of all runs, but this
time grouped by course. Thereafter, this new list is sorted.
In my head, this sounds like a rather simple job for a computer to do. The
number of operations shouldn't be that high, and my guess would be that it
should take about 0.5-5 seconds to execute. This is not the case though - it
takes 3-4 MINUTES! Could this be right?
Here's what I have:
Sheet 1:
A dynamic range with the names of the different courses (about 15 at this
time)
Sheet 2:
-------------------------------------
(The results sorted by date like so
1 Feb 2005; Short Forrest Course; 35:20; 1 / 1;
4 Feb 2005; Long Hill Course; 42:15; 2 / 2;
7 Feb 2005; Short Hill Course; 37:40; 1 / 1;
9 Feb 2005; Long Hill Course; 41:45; 1 / 2;
(As you see, I chose to display the rank as "1 / 2" if the result in
question was the best result out of two runs for a particular course)
(This list is about 90 rows long, at this time)
-------------------------------------
Sheet 3:
-------------------------------------
(This is the result list that the macro produces, it looks something like
this
Long Hill Course:
1; 41:45; 9 Feb 2005
2; 42:15; 4 Feb 2005
3; 44:10; 2 Mar 2005
Short Forrest Course
1; 35:20; 1 Feb 2005
Short Hill Course
1; 37:40; 7 Feb 2005
2; 38:10; 6 Mar 2005
-------------------------------------
And the macro that we're talking about (the one that produces the list for
Sheet 3) looks like this:
-------------------------------------
Sub RunTimeData()
Dim iLastRow As Long
Dim iRow As Long
Dim i As Long, j As Long
Dim iStartRow As Long
Dim iPos As Long
Dim oWs2 As Worksheet
Dim oWs3 As Worksheet
Set oWs2 = Worksheets("Sheet2")
Set oWs3 = Worksheets("Sheet3")
oWs3.Cells.ClearContents
With Worksheets("Sheet1")
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
iRow = iRow + 1
oWs3.Cells(iRow, "A").Value = .Cells(i, "A").Value
iStartRow = iRow + 1
For j = 1 To oWs2.Cells(Rows.Count, "A").End(xlUp).Row
If oWs2.Cells(j, "B").Value = .Cells(i, "A").Value Then
iRow = iRow + 1
With oWs3.Cells(iRow, "A")
.NumberFormat = "@"
iPos = InStr(1, oWs2.Cells(j, "D").Value, "/")
.Value = Trim(Left(oWs2.Cells(j, "D").Value, iPos -
1))
End With
With oWs3.Cells(iRow, "B")
.NumberFormat = "mm:ss"
.Value = oWs2.Cells(j, "C").Value
End With
With oWs3.Cells(iRow, "C")
.NumberFormat = "d mmm yyyy"
.Value = oWs2.Cells(j, "A").Value
End With
End If
Next j
If iStartRow < (j + iLastRow*2) Then
oWs3.Range("A" & iStartRow & ":A" & (j + iLastRow*2)).Sort _
key1:=oWs3.Range("A" & iStartRow), _
header:=xlNo
End If
iRow = iRow + 1
Next i
End With
oWs3.Activate
End Sub
-------------------------------------
Any input would be greatly appreciated!
Sincerely,
Carl
Bookmarks