E
Ernst Guckel
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
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