VBA - Delete row if cell in one column does not match cell in next column

[cyrusharding]

Hi all,

Can someone help me with a VBA code to go through a spreadsheet of over 1,000 rows, and starting at row 6 and continuing until the end of the data set, delete a row if the value in a cell in one column of that row does not match the value in the next column over of that row.
For example, if the value in cell G6 does not match the value in cell H6, I want the program to delete all of row 6 and then move on to the next row (row 7) to see if the value in G7 matches the value in H7, and continue until the end of the data set.

I hope this makes sense. Any assistance would be greatly appreciated!

 

[Fluff]

Hi & welcome to MrExcel.
When you say "Over a 1000 rows" do you mean just over, or do you mean possibly 10,000 rows?

 

[ranman256]

start at bottom and move up. moving down messes with the logic.

Sub DeleteRows()
Dim r As Long
Range("A2").Select
r = ActiveSheet.UsedRange.Rows.Count
Cells(r, 1).Select
While ActiveCell.Value <> "" And ActiveCell.Row > 5
      'delete row
   If ActiveCell.Offset(0, 6).Value <> ActiveCell.Offset(0, 7).Value Then
         Rows(ActiveCell.Row & ":" & ActiveCell.Row).Delete
   End If
   
   ActiveCell.Offset(-1, 0).Select   'previous row
Wend
End Sub

 

[My Aswer Is This]

Try this:

Sub Delete_Rows_If()
'Modified  11/22/2021  11:36:17 AM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "G").End(xlUp).Row

For i = Lastrow To 7 Step -1
    If Cells(i, 7).Value <> Cells(i, 8).Value Then Rows(i).Delete
Next
Application.ScreenUpdating = True
End Sub

 

[Fluff]

Another option if you only have approx 1000 rows

Sub cyrusharding()
   Dim Cl As Range, DelRng As Range
   
   For Each Cl In Range("G6", Range("G" & Rows.Count).End(xlUp))
      If Cl.Value <> Cl.Offset(, 1).Value Then
         If DelRng Is Nothing Then Set DelRng = Cl Else Set DelRng = Union(DelRng, Cl)
      End If
   Next Cl
   If Not DelRng Is Nothing Then DelRng.EntireRow.Delete
End Sub

 

[cyrusharding]

Hi & welcome to MrExcel.
When you say "Over a 1000 rows" do you mean just over, or do you mean possibly 10,000 rows?

Hi thank you! Just over 1,000, not possibly 10,000.

 

[Fluff]

In that case all the codes posted should work.

 

[cyrusharding]

Thanks everyone for your quick replies. I'm sure it is user error, but the first two codes did not work for me. However, the third code from Fluff worked perfectly.

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[My Aswer Is This]

Thanks everyone for your quick replies. I'm sure it is user error, but the first two codes did not work for me. However, the third code from Fluff worked

Would you care to say what my script did not do It worked for me.