Have you tried setting the Calculation property to
xlCalculationManual at the beginning of your code
and setting it back to xlCalculationAutomatic at the
end? Also turn screen updating off. I wouldn't think
it would take all that long to run through a 60 x 3
( or a 61 x 4) array. I was not able to understand the
logic behind your code but the following untested code
appears to me to do what your code does. You could
test it to see if it works and if you gain any speed. If
you test it and have a problem with it let me know.
If anyone else wishes to comment on the following code
please feel free.
Sub Sunday()
Dim TheArray() As Variant
Dim EndArray(1 To 41, 1 To 3) As Variant
Dim Compare(1 To 4) As Double
Dim C As Range
Dim a As Integer, s As Integer, R As Integer
Dim b As Integer, x As Integer
Dim e As Variant
Compare(1) = 0.458 '''Lunch
Compare(2) = 0.625 '''After
Compare(3) = 0.708 '''Diner
Compare(4) = 0.833 '''Late
s = Application.Count(Range("Sunday"))
ReDim TheArray(1 To s, 1 To 3)
a = 0
Application.ScreenUpdating = False
Range("A9:C49").ClearContents
For Each C In Range("Sunday")
If TypeName(C.Value) = "Double" Then
a = a + 1
TheArray(a, 1) = C.Value
TheArray(a, 2) = C.Cells(1, 2).Value
TheArray(a, 3) = C.Cells(1, -1).Value
End If
Next
BubbleSort TheArray
R = 1
a = 1
b = 1
Do While a <= s
e = TheArray(a, 1)
For x = b To 4
If e >= Compare(x) Then
If x = 2 Then
'''After
R = R + 7
Else
'''Lunch, Dinner or Late
R = R + 1
End If
b = b + 1
Else
Exit For
End If
Next
EndArray(R, 1) = TheArray(a, 1)
EndArray(R, 2) = TheArray(a, 2)
EndArray(R, 3) = TheArray(a, 3)
R = R + 1
a = a + 1
Loop
Range("A9:C49").Value = EndArray()
Application.ScreenUpdating = True
End Sub
HTH,
Phil.
========================
<< Hello,
Can anyone tell me why this code is so slow? The BubbleSort function does
not seem to be the problem... Mabey the:
If Application.WorksheetFunction.IsText(e) = True Then GoTo Bottom
Any ideas would be great...
Ernst.
Sub Sunday()
Dim TheArray(60, 3) As Variant
Dim a, C, e, R
Dim Lunch, After, Dinner, Late As Boolean
a = 0
Range("A9:C49").ClearContents
' Create the array.
For Each C In Range("Sunday")
a = a + 1
TheArray(a, 1) = C.Value
TheArray(a, 2) = C.Cells(1, 2).Value
TheArray(a, 3) = C.Cells(1, -1).Value
Next
' Sort the Array and display the values in order.
BubbleSort TheArray
R = 9
For a = 1 To UBound(TheArray)
e = TheArray(a, 1)
If e = "" Then GoTo Bottom
If Application.WorksheetFunction.IsText(e) = True Then GoTo Bottom
If Lunch = False Then
If e >= 0.458 Then
R = R + 1
Lunch = True
End If
End If
If After = False Then
If e >= 0.625 Then
R = R + 7
After = True
End If
End If
If Dinner = False Then
If e >= 0.708 Then
R = R + 1
Dinner = True
End If
End If
If Late = False Then
If e >= 0.833 Then
R = R + 1
Late = True
End If
End If
Range("A" & R).Value = TheArray(a, 1)
Range("B" & R).Value = TheArray(a, 2)
Range("C" & R).Value = TheArray(a, 3)
R = R + 1
Bottom:
Next
End Sub >>
slow code?