Macro - compare and delete row

[roof16]

I am trying to build a simple macro that will compare two cells and if the values are the same it will delete that row, the code I am working from so far:

Sub CompareRowsandDelete()
Dim i As Long
For i = 3 To 358
    If Range("O" & i) = Range("Q" & i) Then
          Cells(i).EntireRow.Delete
    End If
Next i
End Sub

It's not deleting all the rows that have the same values. Any suggestions?

 

[Joe4]

Since deleting rows shifts rows UPWARDS, you need to loop through your list backwards to make sure that you don't miss any (rows moving upwards while you are moving downwards).
Try:

Sub CompareRowsandDelete()
Dim i As Long
[COLOR=#ff0000]For i = 358 To 3 Step -1[/COLOR]
    If Range("O" & i) = Range("Q" & i) Then
          Cells(i).EntireRow.Delete
    End If
Next i
End Sub

 

[JoeMo]

You need to work from the bottom up. Try:

For i = 358 to 3 Step -1

You might want to suppress calculations and screen updating while you do the deletions to speed up the process. Like this:

Sub CompareRowsandDelete()
Dim i As Long
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
For i = 358 To 3 Step -1
    If Range("O" & i) = Range("Q" & i) Then
          Cells(i,"O").EntireRow.Delete
    End If
Next i
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

If you have a large number of rows, there are faster ways to do the deletion, but for your 356 rows this should be fast enough.

 

[roof16]

Thanks, JoeMo this did it, speed it not an issue but the number of rows should increase over time for my report.

 

[JoeMo]

You are welcome - thanks for the reply.

 

[Rick Rothstein]

Thanks, JoeMo this did it, speed it not an issue but the number of rows should increase over time for my report.

Here is another macro (no loops so you don't have to worry about direction) that you can consider (it should be relatively fast no matter how many rows of data there are)...

[table="width: 500"]
[tr]
	[td]Sub DeleteIfRowsOandQequal()
  Dim LastRow As Long
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  Range("O1:O" & LastRow) = Evaluate(Replace("IF(O1:O@=Q1:Q@,""#N/A"",O1:O@)", "@", LastRow))
  On Error GoTo NoDupes
  Columns("O").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
NoDupes:
End Sub[/td]
[/tr]
[/table]