Delete non duplicate rows

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
365
Greetings folks,

I have a spreadsheet that contains many rows of data. Some of the cell values in column A are duplicates while others are unique and there is only 1. I would like to use VBA to delete the rows that contain unique values in column A, while leaving the duplicate values (+ their corresponding rows) found in column A.

Any assistance would be greatly appreciated.

C
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
How about
VBA Code:
Sub christianbiker()
   Dim UsdRws As Long
   
   UsdRws = Range("A" & Rows.Count).End(xlUp).Row
   With Cells(1, Columns.Count).End(xlToLeft).Offset(1, 1).Resize(UsdRws)
      .Formula = "=if(countifs(a:a,a2)>1,"""",1)"
      .Value = .Value
      .SpecialCells(xlConstants).EntireRow.Delete
   End With
End Sub
 
Upvote 0
Ohhhh....that's excellent Fluff! Thanks a ton...

As I think about this, with the same reasoning in mind, instead of deleting the whole row is it possible to delete only the data in columns A thru F?
 
Upvote 0
Ok, how about
VBA Code:
Sub christianbiker()
   Dim UsdRws As Long
   
   UsdRws = Range("A" & Rows.Count).End(xlUp).Row
   With Cells(1, Columns.Count).End(xlToLeft).Offset(1, 1).Resize(UsdRws)
      .Formula = "=if(countifs(a:a,a2)>1,"""",1)"
      .Value = .Value
      Intersect(.SpecialCells(xlConstants).EntireRow, Range("A:F")).Delete
   End With
End Sub
 
Upvote 0
That works but I have created another problem for myself! I use the below code to separate the duplicates, but it inserts a whole new row. I only want to insert a row for columns A:F like yours as there are formulas outside that area that I need to stay in place. Is there an easy solution?

VBA Code:
 Dim lRow As Long
 For lRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row To 2 Step -1
 If Cells(lRow, "A") <> Cells(lRow - 1, "A") Then Rows(lRow).EntireRow.Insert
 Next lRow
 
Upvote 0
Try
VBA Code:
If Cells(lRow, "A") <> Cells(lRow - 1, "A") Then Range("A" & lRow).Resize(, 6).Insert xlShiftDown
 
Upvote 0
My pleasure & thanks for the feedback.
 
Upvote 0
Ok...so I am trying to figure out how to use the below formula to clear contents rather than deleting the row. I tried using ".clearcontents" instead of ".delete" at the end but it didn't work. I know it's a simple fix but I'm at a loss...

VBA Code:
Application.ScreenUpdating = False

   Dim UsdRws As Long
  
   UsdRws = Range("A" & Rows.Count).End(xlUp).Row
   With Cells(1, Columns.Count).End(xlToLeft).Offset(1, 1).Resize(UsdRws)
      .Formula = "=if(countifs(a:a,a2)>1,"""",1)"
      .Value = .Value
      Intersect(.SpecialCells(xlConstants).EntireRow, Range("A:D")).Delete
   End With
  
Application.ScreenUpdating = True
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,941
Members
448,534
Latest member
benefuexx

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
Back
Top