Hello,

I have a list of employees on a schedule. I have a piece of code look
them up, sort them by start time, and then put them on a daily line up for
printing.. Problem is that it takes a long time on the work PC's (200mhz).
The problem seems to be after the array returns sorted. I cannot seem to
figure it out. Any ideas?

Thanks...

Sub Sunday(week)

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 a new progress bar
Set sb = New clsProgressBar

' Display the progress bar
sb.Show constWait, vbNullString, 0

' Create the array.

For Each c In Range(week)

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

'Lag seems to start here...
R = 10

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.58 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:
sb.PercentComplete = (a / 60) * 100
Next

End Sub