Help with macro to delete rows

  • Thread starter Thread starter mattg
  • Start date Start date
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
 
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.
 
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.
 
I get an "application defined or object defined" error on the line where the
formula is entered
 
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
 
..Range("Z2").Formula = "=if(D2=D1,"""",if(D2=D3,"""",0))"

You need to double quotes instead of 1
 
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.
 
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
 
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
 
Back
Top