OPTION EXPLICIT
Sub delRws()
Dim lstRw As Long, i As Long
lstRw = Cells(Rows.Count, "d").End(xlUp).Row

For i = lstRw To 2 Step -1
If NOT (Cells(i, "d") = Cells(i - 1, "d") And Cells(i, "d") =
Cells(i + 1, "d") ) Then
Row(i).Delete
end if
Next
End Sub

"mattg" wrote in message
...
I'm tyring to delete rows based on these criteria: If the value of any
given
cell in column D does not match the value of the cell before it or the
cell
after it within that column delete the entire row.

To do it manually I use the formula =if(D2=D1,1,if(D2=D3,1,))

Then I delete the rows with "0" value

Here is what I have so far that doesn't work:

Sub delRws()


Dim lstRw As Long, i As Long

lstRw = ActiveSheet.Cells(Rows.Count, "d").End(xlUp).Row

For i = lstrow To 2 Step -1
If ActiveSheet.Cells(i, "d") < ActiveSheet.Cells(i - 1, "d") And
ActiveSheet.Cells(i, "d") < ActiveSheet.Cells(i + 1, "d") Then
EntireRow.Delete

Next

End Sub

Thanks in advance