Delete non duplicate rows

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
360
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
 

Some videos you may like

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
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
 

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
360
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?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
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
 

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
360

ADVERTISEMENT

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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
Try
VBA Code:
If Cells(lRow, "A") <> Cells(lRow - 1, "A") Then Range("A" & lRow).Resize(, 6).Insert xlShiftDown
 

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
360

ADVERTISEMENT

Hey Fluff...that works excellent. Thanks a bunch for your assistance!!! :)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
My pleasure & thanks for the feedback.
 

christianbiker

Active Member
Joined
Feb 3, 2006
Messages
360
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
In what way didn't it work?
 

Watch MrExcel Video

Forum statistics

Threads
1,114,193
Messages
5,546,481
Members
410,742
Latest member
WalterSil
Top