Macro to remove Dupes

Yes...that was very helpful, But im looking to automate it. This will speed up the manual process, but in reality, I have 10 reports that i have to remove the dupes.

Is there a macro, or some kind of code i can use?

Try this on a copy of your workbook.

Sub Delete_Duplicates()
    Dim i As Long
    For i = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Application.CountIf(Range("B1", "B" & i), Range("B" & i)) > 1 Then Range("B" & i).Delete Shift:=xlUp
    Next i
End Sub

To delete rows, change

If Application.CountIf(Range("B1", "B" & i), Range("B" & i)) > 1 Then Range("B" & i).Delete Shift:=xlUp

to

If Application.CountIf(Range("B1", "B" & i), Range("B" & i)) > 1 Then Range("B" & i).EntireRow.Delete

I would suggest changing

Then Range("B" & i).Delete Shift:=xlUp

to

Then Range("B" & i).EntireRow.Delete

to delete the entire row.

One thing to note, however, is that the values in column A are not identical when the values in column B are. (All of the other columns appear to have matching data in your sample.)

If you don't care about the data in the other columns, and just want to keep the first instance of any dupe in column B, then the code as provided will suffice. (I'd also recommend turning off ScreenUpdating at the beginning of the code, then turning it back on at the end. This will reduce flicker and actually make the macro run faster since it doesn't have to update the screen for every row it deletes.)

If the data in other columns does matter - and must all match in order for that row to be deleted - then another approach will be necessary.

Hope that helps!

please check attachment, run macro "test"

Not to be overly critical of watersev's code, but that has to be one of the best attempts at thoroughly overachieving as a programmer, while at the same time ensuring that the novice user can never adjust the code without help.

Removing duplicates from a list can be done in ONE line of code.

Range("$A$1:$P$27").RemoveDuplicates Columns:=Array(2, 3, 4, 5, 6, 7, 8 _
        , 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes

This removes all duplicate rows where columns 2:16 have matching data. If you don't need to match all 15 columns, remove them from the array. If your range is not always A1:P27, get the last used row and insert that value in just one additional line of code.

It's really not as difficult as some make it out to be.

In 2003 I would recommend your simple loop, with screenupdating turned off. One variable, one loop, done. Yes there are ways to do it using arrays, collections, dictionary scripting objects, etc., and some of them might be quicker on large data sets, but if the user doesn't know VBA from a hole in the wall there is little chance they can adapt the code to their real workbooks unless they are identical in structure to the sample and each other.

I haven't searched for 'RemoveDuplicates' macros designed for 2003, but I'm sure some exist.

These are just my opinions, your mileage may vary.

Hello H-Man3,

Paul is correct that in Excel versions prior to 2007 there is no built-in method to remove duplicates. Also, he stated there are a variety of ways to accomplish the task.

This macro uses the Dictionary object, which become available with the release of Windows 2000. I prefer this object for its speed and flexibility. Comments have been added to explain the operation of the code.

The Attached workbook has the macro added. Use the keys Ctrl+Shift+D to run the macro. You will be prompted for the column and the starting cell of the table. Most of the code is just to get information from the user and handle potential errors.

'Written: February 23, 2011
'Author:  Leith Ross (www.excelforum.com0

Sub RemoveDuplicates()

  Dim Cell As Range
  Dim Dict As Object
  Dim FirstCell As Variant
  Dim Key As String
  Dim SearchColumn As Variant
  Dim Rng As Range
  
    'Ask for the search column
     Msg = "Enter the column you want to search for duplicates. Enter either a number or letter."
    
     SearchColumn = InputBox(Msg)
       If SearchColumn = "" Then
         'User Clicked Cancel
          Exit Sub
       End If
     
    'Ask for the cell in the Upper Left Corner of the table
     Msg = "Click the cell that is in the Upper Left Corner of the Table if different than shown below."
     
     On Error Resume Next
       Set FirstCell = Application.InputBox(Prompt:=Msg, Default:="$A$1", Type:=8)
         If Err <> 0 Then
           'User Clicked Cancel
            Exit Sub
         End If
     On Error GoTo 0
     
      'Create the lookup array
       Set Dict = CreateObject("Scripting.Dictionary")
       Dict.CompareMode = vbTextCompare
      
      'Get all cells in the table
       If Rng Is Nothing Then
          MsgBox "The Table selected contains No Data."
          Exit Sub
       End If
       Set Rng = FirstCell.CurrentRegion
       
      'Convert the search column letter into a number
       SearchColumn = Cells(1, SearchColumn).Column
      
        'Clear the row if the entry in the search column is found more than once
         For Each Cell In Rng.Columns(SearchColumn).Cells
           Key = Trim(Cell.Text)
             If Key <> "" And Not Dict.Exists(Key) Then
                Dict.Add Key, 1
             Else
                Cell.EntireRow.ClearContents
             End If
         Next Cell
      
      'Sort the table to remove the blank rows (low to high)
       Rng.Sort Key1:=Rng.Cells(1, SearchColumn), Order1:=xlAscending, _
               Header:=xlGuess, MatchCase:=False, Orientation:=xlTopToBottom
                     
End Sub