Deleting Duplicate Rows with a Catch

herpasymplex10

Board Regular
Joined
May 26, 2005
Messages
224
I've seen this topic very often and did a lot of searching on previous threads but did not find a solution to my situation.

I would like a macro that could hopefully do the following.

Look at all the rows in my worksheet
and delete duplicate rows in certain situations.

If Row 117, 118, and 119 are all identical,
it would delete all but on of them.

The catch is row 502 may be the same as all of the above
but I don't want it deleted. Only if consecutive rows are duplicates
should the macro delete all but one.

Anyone have any ideas?

Thanks,
Christian
 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Carly

Active Member
Joined
Aug 21, 2002
Messages
370
How about trying something like this? This test is just checking the values in column A to see if they match but you can change this to wherever your data is the same.

Code:
Sub test()
Range("A1").End(xlDown).Select
Do While Not ActiveCell.Row = 1
    If ActiveCell.Offset(1, 0).Value <> ActiveCell.Value Then
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.EntireRow.Delete
        ActiveCell.Offset(-1, 0).Select
    End If
Loop
    If ActiveCell.Offset(1, 0).Value <> ActiveCell.Value Then
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.EntireRow.Delete
    End If
End Sub
 

herpasymplex10

Board Regular
Joined
May 26, 2005
Messages
224
How about trying something like this? This test is just checking the values in column A to see if they match but you can change this to wherever your data is the same.

Code:
Sub test()
Range("A1").End(xlDown).Select
Do While Not ActiveCell.Row = 1
    If ActiveCell.Offset(1, 0).Value <> ActiveCell.Value Then
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.EntireRow.Delete
        ActiveCell.Offset(-1, 0).Select
    End If
Loop
    If ActiveCell.Offset(1, 0).Value <> ActiveCell.Value Then
        ActiveCell.Offset(-1, 0).Select
    Else
        ActiveCell.EntireRow.Delete
    End If
End Sub

Hmmm. I'm getting an error

"Run time error '1004':
Application defined or object defined error:

pointing here

Code:
ActiveCell.Offset(-1, 0).Select
 

Carly

Active Member
Joined
Aug 21, 2002
Messages
370
maybe try

Code:
Range("A1").End(xlDown).Select 
Do While Not ActiveCell.Row = 1 
    If ActiveCell.Offset(1, 0).Value <> ActiveCell.Value Then 
        ActiveCell.Offset(-1, 0).Select 
    Else 
        ActiveCell.EntireRow.Delete 
        ActiveCell.Offset(-1, 0).Select 
    End If 
Loop 
    If ActiveCell.Offset(1, 0).Value = ActiveCell.Value Then 
        ActiveCell.EntireRow.Delete 
    End If 
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,393
Office Version
  1. 365
Platform
  1. Windows
Christian

Note that in most cases when using code you do not have to actually select cells to work with them. The code will run much faster if you avoid selecting. Here is my suggested code. It also assumes the data is in column A (column 1).

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> DeleteRows()
    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    <SPAN style="color:#00007F">For</SPAN> r = lr <SPAN style="color:#00007F">To</SPAN> 2 <SPAN style="color:#00007F">Step</SPAN> -1
        <SPAN style="color:#00007F">If</SPAN> Cells(r, 1).Value = Cells(r - 1, 1).Value <SPAN style="color:#00007F">Then</SPAN>
            Rows(r).EntireRow.Delete
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> r
    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
 

Watch MrExcel Video

Forum statistics

Threads
1,127,321
Messages
5,624,003
Members
416,004
Latest member
reitz1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top