Help with macro to delete rows

[mattg]

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

 

[Jacob Skaria]

Check the variable names lstRow OR lstRw

If this post helps click Yes

 

[Joel]

I don't know how many rows you plan to delete, but to delete each row one at
a time is slow. To speed up the process I sometimes put the formula into a
new row like what you did. then sort the 1's to the top of the spreadsheet.
Nextt delete the rows with the ones in 1 step

with ActiveSheet
lstRw = .Cells(Rows.Count, "d").End(xlUp).Row
'add formula to column z
.range("Z" & 2).formula = "=if(D2=D1,"",if(D2=D3,"",0))"
.range("Z" & 2).copy _
destination:=.range("Z" & 2 & ":Z" & lstRw)
Rows("2:" & Lstrw).sort _
key1:=.range("Z2")
lstZero = .Cells(Rows.Count, "z").End(xlUp).Row
if lstZero > 1 then
.rows("2:" & lstZero).delete
end if

end with

It is a lot of code but it is much quicker than deleting 100 row 1 at a time.

 

[mattg]

I fixed the spelling and it works better but it delets rows it shouldn't and
doesn't delete ones it should. Can I use better logic? Basically I want to
delete or hide the entire row if the value of the cell in column D occurs
only once in that column.

 

[r]

column D is sorted?
regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/index.php/Excel-VBA/UsedRange-eccezioni-e-alternative.html

 

[mattg]

I get an "application defined or object defined" error on the line where the
formula is entered

 

[Jacob Skaria]

Try the below

Sub delRws()

Dim lngRow As Long
Dim lngLastRow As Long
Dim varTemp As Variant
lngLastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row - 1
varTemp = Range("D" & lngLastRow)

For lngRow = lngLastRow To 3 Step -1
If Range("D" & lngRow) = 0 Or (Range("D" & lngRow) _
<> Range("D" & lngRow - 1) And _
Range("D" & lngRow) <> Range("D" & lngRow + 1)) Then
Rows(lngRow).EntireRow.Delete
End If
varTemp = Range("D" & lngRow)
Next

End Sub


If this post helps click Yes

 

[Joel]

..Range("Z2").Formula = "=if(D2=D1,"""",if(D2=D3,"""",0))"

You need to double quotes instead of 1

 

[mattg]

Hi Joel,

The formula gets entered correctly and produces the correct "1" or zero but
then every row is deleted regardless if it has "1" or zero in Column Z.

 

[Joel]

the formulas were showing up as having data in the cells even through the
cells appeared to be empty.


Sub test1()
With ActiveSheet
lstRw = .Cells(Rows.Count, "d").End(xlUp).Row
'add formula to column z
.Range("Z" & 2).Formula = "=if(D2=D1,"""",if(D2=D3,"""",0))"
.Range("Z" & 2).Copy _
Destination:=.Range("Z" & 2 & ":Z" & lstRw)
.Columns("Z").Copy
.Columns("Z").PasteSpecial _
Paste:=xlPasteValues
Rows("2:" & lstRw).Sort _
key1:=.Range("Z2")
Set c = .Range("Z2:Z" & lstRw).Find(what:=0, _
LookIn:=xlValues, lookat:=xlWhole, _
SearchDirection:=xlPrevious)

If Not c Is Nothing Then
.Rows("2:" & c.Row).Delete
End If
End With
End Sub

 

[Patrick Molloy]

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