Help with macro to delete rows

M

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
 
J

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.
 
M

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.
 
M

mattg

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

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
 
J

Joel

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

You need to double quotes instead of 1
 
M

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.
 
J

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
 
P

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top