View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
JE McGimpsey JE McGimpsey is offline
external usenet poster
 
Posts: 4,624
Default VBA (Optimization) Help to replace inefficient Do .. Loops ...

This is untested, but I believe it will do what your loops do in one
pass through the data:

Public Sub Test()
Dim iExcludedBrks As Variant
Dim rCell As Range
Dim rDelete As Range
Dim iTestTime As Double
Dim iExCount As Long
Dim iTestDate As Long
Dim sLastUpdateDate As String
Dim sLastUpdateTime As String
Dim sTemp As String
Dim bDelete As Boolean

'Setup stuff here

For Each rCell In Range("P3:P" & _
Range("P" & Rows.Count).End(xlUp).Row)
With rCell
If .Text < "SETL" Then
bDelete = True
Else
With .Offset(0, 1)
For iExCount = LBound(iExcludedBrks) To _
UBound(iExcludedBrks)
If .Text = iExcludedBrks(iExCount) Then
bDelete = True
Exit For
End If
Next iExCount
End With
If Not bDelete Then
sTemp = Trim(.Offset(0, 2).Text)
iTestDate = CDate(Left(sTemp, 4) & "/" & _
Mid(sTemp, 5, 2) & "/" & Mid(sTemp, 7, 2))
If iTestDate < CDate(sLastUpdateDate) Then
bDelete = True
Else
sTemp = Right(sTemp, 6)
iTestTime = TimeValue(Left(sTemp, 2) & ":" & _
Mid(sTemp, 3, 2) & ":" & _
Application.Min(59, CLng(Right(sTemp, 2))))
If iTestTime < TimeValue(sLastUpdateTime) Then _
bDelete = True
End If
End If
End If
End With
If bDelete Then
If rDelete Is Nothing Then
Set rDelete = rCell
Else
Set rDelete = Union(rDelete, rCell)
End If
End If
Next rCell
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub

In article ,
Philip wrote:

I am sure there must be a better way...