Hi Gord:

This isn't working as it should...It deletes some of the Zero Records in I
for LOA, Termed and Duplicate, but not all of them.

Can you help me revise this to work correctly? I appreciate your expertise.

I want to delete all rows that have Zero in Column I and have LOA, Termed or
Duplicate in Column J....If there is a "1" or greater # in Column I, I want
the record to remain. I'm not sure waht is wrong with this.

Option Compare Text
Sub DeleteLOATermedDupRecords()
Application.Calculation = xlCalculationManual
Dim rng1 As Range
check_words = Array("LOA", "Termed", "Duplicate")
Set rng1 = Range("J1", Cells(Rows.Count, "J").End(xlUp))
For i = LBound(check_words) To UBound(check_words)
For Each cell In rng1
If InStr(1, cell.Value, check_words(i)) Then
cell.EntireRow.Delete
End If
Next
Next
Application.Calculation = xlCalculationAutomatic
End Sub
--
jeannie v


"Gord Dibben" wrote:

Try this one. Looks a little faster.

Option Compare Text
Sub DeleteLOATermedDupRecords()
Dim rng1 As Range
check_words = Array("LOA", "Termed", "Duplicate")
Set rng1 = Range("J1", Cells(Rows.Count, "J").End(xlUp))
For i = LBound(check_words) To UBound(check_words)
For Each cell In rng1
If InStr(1, cell.Value, check_words(i)) Then
cell.EntireRow.Delete
End If
Next
Next
End Sub


Gord Dibben MS Excel MVP

On Mon, 18 Feb 2008 17:24:01 -0800, jeannie v
wrote:

Hi Experts:

I have used this macro before and it worked perfectly...however, now when it
searches and deletes the rows that I want it to, it takes forever to go
through the document....It used to go through very fast and deleted the rows,
but now it deletes one row at a time very slowly....I have about 10000
records for it to go through and delete the records that are in the macro and
it takes a long time to complete...What might be wrong with this Macro?

Sub DeleteLOATermedDupRecords()
'
' DeleteLOATermedDupRecords Macro
' Macro recorded 2/17/2008 by Jeannie Vincovich
'
For i = 1 To 12000
If Cells(i, "J") = "LOA" Or Cells(i, "J") = "Termed" Or _
Cells(i, "J") = "Duplicate" Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
i = i - 1
End If
Next i

End Sub


Any help you can provide would be greatly appreciated.