Delete Duplicates Across Two Columns

[Michael151]

Hello all,

Trying to write a macro that will delete duplicates within two columns.

I have two columns named Title and Notes - if there are more than one exact match, then delete the extra rows (do not hide).

For example:

Before:

Title Notes
Title1 Notes1
Title1 Notes1
Title2 Notes2
Title2 Notes3

After:

Title Notes
Title1 Notes1
Title2 Notes2
Title2 Notes3

*The duplicate entry of Title1 gets deleted.

Thank you!

 

[Marcelo Branco]

Hi,

Using the macro recorder
Select the range and Data>Remove Duplicates

I got this

Sub Macro2()
    Range("D1:E5").Select
    ActiveSheet.Range("$D$1:$E$5").RemoveDuplicates Columns:=Array(1, 2), Header _
        :=xlNo
End Sub

Adjust the range

HTH

M.

 

[Norie]

Couldn't you do that with advanced filter?

Here's the code from the recorder based on your data starting in A1.

    Range("A1:B5").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("I1" _
        ), Unique:=True

That copies the result to another location though.

 

[Michael151]

Thanks but I get an error message saying "Run-time error 438" object doesn't support this property or method.

I am using excel 2003. When I do use the the macro recorder and advanced filter - it simply hides the duplicates. I'd like to delete the duplicate rows.

Thanks for your help.

 

[Norie]

The code I posted will work with 2003, but like I said it will copy the results to another range.

Would that not work?

 

[Michael151]

Thanks Norie, the only thing is that this filter hides the duplicates, but it does not delete them. Is there any way to write a macro that will delete the duplicate rows, not just hide them.

 

[rsulliva]

The following code test 8 columns but you should be able to modify this code to suit your needs:

Sub TestForDups()

    Dim LLoop As Integer
    Dim LTestLoop As Integer

    Dim Lrows As Integer
    Dim LRange As String

    Dim LCnt As Integer

    'Column values
    Dim LColA_1, LColB_1, LColC_1, LColD_1, LColE_1, LColF_1, LColG_1, LColH_1 As String
    Dim LColA_2, LColB_2, LColC_2, LColD_2, LColE_2, LColF_2, LColG_2, LColH_2 As String

    'Test first 2000 rows in spreadsheet for duplicates (delete any duplicates found)
    Lrows = 2000
    LLoop = 2
    LCnt = 0

    'Check first 2000 rows in spreadsheet
    While LLoop <= Lrows
        LColA_1 = "A" & CStr(LLoop)
        LColB_1 = "B" & CStr(LLoop)
        LColC_1 = "C" & CStr(LLoop)
        LColD_1 = "D" & CStr(LLoop)
        LColE_1 = "E" & CStr(LLoop)
        LColF_1 = "F" & CStr(LLoop)
        LColG_1 = "G" & CStr(LLoop)
        LColH_1 = "H" & CStr(LLoop)

        If Len(Range(LColA_1).Value) > 0 Then

            'Test each value for uniqueness
            LTestLoop = LLoop + 1
            While LTestLoop <= Lrows
                If LLoop <> LTestLoop Then
                    LColA_2 = "A" & CStr(LTestLoop)
                    LColB_2 = "B" & CStr(LTestLoop)
                    LColC_2 = "C" & CStr(LTestLoop)
                    LColD_2 = "D" & CStr(LTestLoop)
                    LColE_2 = "E" & CStr(LTestLoop)
                    LColF_2 = "F" & CStr(LTestLoop)
                    LColG_2 = "G" & CStr(LTestLoop)
                    LColH_2 = "H" & CStr(LTestLoop)

                    'Value has been duplicated in another cell (based on values in columns A to H)
                    If (Range(LColA_1).Value = Range(LColA_2).Value) _
                     And (Range(LColB_1).Value = Range(LColB_2).Value) _
                     And (Range(LColC_1).Value = Range(LColC_2).Value) _
                     And (Range(LColD_1).Value = Range(LColD_2).Value) _
                     And (Range(LColE_1).Value = Range(LColE_2).Value) _
                     And (Range(LColF_1).Value = Range(LColF_2).Value) _
                     And (Range(LColG_1).Value = Range(LColG_2).Value) _
                     And (Range(LColH_1).Value = Range(LColH_2).Value) Then

                        'Delete the duplicate
                        Rows(CStr(LTestLoop) & ":" & CStr(LTestLoop)).Select
                        Selection.Delete Shift:=xlUp

                        'Decrement counter since row was deleted
                        LTestLoop = LTestLoop - 1

                        LCnt = LCnt + 1

                    End If

                End If

                LTestLoop = LTestLoop + 1
            Wend

        End If

        LLoop = LLoop + 1
    Wend

    'Reposition back on cell A1
    Range("A1").Select
    MsgBox CStr(LCnt) & " rows have been deleted."

End Sub

Source: http://www.techonthenet.com/excel/macros/test_dups3.php