Deleting duplicate rows based on multiple values

[kvasir42]

Hi all, long-time anon, first-time poster.

I'm a little stuck. I have a massive sheet of raw sales data that I'm trying to analyze to see if we paid what we're supposed to be paying; however, the sales data is only in a per month basis. I've figured out how to get the unit price we're paying but I also need to transfer those numbers into a more "presentation-ready" spreadsheet for the execs (they don't like to see 9000 lines of raw data for some reason). Unfortunately, I can't use VLOOKUP like normal since there are multiple lines with the same SKU (representing different purchases from different facilities at different times).

What I need is to write a macro that scans column D for repeated values and then deletes all but one row with that value in column D (and I mean delete, not hide). My VBA is kinda crap though. Any thoughts?

Thanks!

 

[AlphaFrog]

You could record a macro with these steps:

• Select Column D
• Advanced Filter:
  • Filter the list in Place
  • Unique Records only
• Select all filtered rows (Ctrl+Shift+8)
• Copy
• Paste to empty worksheet

 

[Mike LH]

Hi,

As requested this deletes stuff; lots of it, so ensure you run it on a copy of your data first. It will keep the topmost row for each set of duplicates and delete the rest.

Sub Find_All()
Dim FindRange As Range, c As Range
Dim LastRow As Long, MyRange As Range
Dim FirstAddress As String, cel As Range
LastRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row
Set MyRange = Range("D2:D" & LastRow)
For Each cel In MyRange
     Set c = Columns(4).Find(cel.Value, LookIn:=xlValues, LookAt:=xlWhole)
     If Not c Is Nothing Then
         FirstAddress = c.Address
         Do
           If FindRange Is Nothing And FirstAddress <> c.Address Then
                 Set FindRange = c
         Else
             If FirstAddress <> c.Address Then Set FindRange = Union(FindRange, c)
         End If
             Set c = Columns(4).FindNext(c)
         Loop While Not c Is Nothing And c.Address <> FirstAddress
     End If
 If Not FindRange Is Nothing Then
     FindRange.EntireRow.Delete
 End If
 Set FindRange = Nothing
 Next

 End Sub

 

[kvasir42]

You could record a macro with these steps:

• Select Column D
• Advanced Filter:
  • Filter the list in Place
  • Unique Records only
• Select all filtered rows (Ctrl+Shift+8)
• Copy
• Paste to empty worksheet

Durr. Thank you. Staring at things too long makes me go something something.