Results 1 to 13 of 13
  1. #1
    Star Lounger
    Join Date
    Dec 2009
    Location
    Buenos Aires, Argentina
    Posts
    54
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Delete both duplicate rows

    Hello

    In Excel 2003 I have a list of emails with many duplicated addresses and I need to remove both duplicates, and leave the list with only the unique addresses.

    I would need a macro that deletes both rows of the same address.

    Here is one example, but it doesn't work or I am doing something wrong:

    Sub Delete()
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = Cells(i - 1, 2) Then
    Cells(i, 1).EntireRow.Delete
    Cells(i - 1, 1).EntireRow.Delete
    End If
    Next i
    End Sub


    Any help?
    Many thanks.

  2. #2
    Lounger
    Join Date
    Feb 2011
    Posts
    28
    Thanks
    0
    Thanked 10 Times in 8 Posts
    Hi,

    I read your post to mean that if you have a list that if you have address a,b,b,b,c,d,d,e,f,f,f,g you would end up with a,c,e,g after all the duplicate ones had been removed. Here's some code adapted from a macro I already had:

    Sub RemoveDups()
    '
    Dim i As Long
    Dim lngRows As Long
    Dim strA As String 'to compare values
    Dim strB As String

    'Find last row

    ActiveCell.SpecialCells(xlLastCell).Select
    lngRows = Selection.Row

    For i = 1 To lngRows

    strA = Range("A" & i).Text & Range("B" & i).Text
    strB = Range("A" & (i + 1)).Text & Range("B" & i).Text

    If strA = "" And strB = "" Then End
    Do Until strA <> strB
    Rows(i + 1).Select
    Selection.Delete Shift:=xlUp
    lngRows = lngRows - 1
    strB = Range("A" & (i + 1)).Text & Range("B" & (i + 1)).Text
    Rows(i).Select
    Loop
    Selection.Delete Shift:=xlUp '*
    lngRows = lngRows - 1 '*
    Next i
    Range("A1").Select
    End Sub

    If you want to be left with a,b,c,d,e,f,g then remove the two lines marked *

    Hope this helps.

  3. #3
    Star Lounger
    Join Date
    Dec 2009
    Location
    Buenos Aires, Argentina
    Posts
    54
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hi and many thanks for the macro.

    I have tried but it doesn't work with the list of emails. But if I make a list with the example you give me (a,b,b,b,c,d,d,e,f,f,f,g) it works! (a,c,e,g)

    Is there a problem with the @ or other thing?

  4. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Could you attached a sample file that does not work, so the code can be debugged?

    Steve

  5. #5
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Other options for removing duplicates can be done without code:
    1) If you have XL2007+, you could select the column and press the data - remove duplicate button
    2) use Advanced filter and to copy the unique records to a new column
    3) use an intermediate column with a countif formula to display the count of the items and then filter on this for the count >1 and delete those rows. You could then delete the intermediate column and autofilter

    Steve

  6. #6
    Star Lounger
    Join Date
    Dec 2009
    Location
    Buenos Aires, Argentina
    Posts
    54
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by sdckapr View Post
    Could you attached a sample file that does not work, so the code can be debugged?

    Steve
    Here it is a sample list.
    Attached Files Attached Files

  7. #7
    Star Lounger
    Join Date
    Dec 2009
    Location
    Buenos Aires, Argentina
    Posts
    54
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by sdckapr View Post
    Other options for removing duplicates can be done without code:
    1) If you have XL2007+, you could select the column and press the data - remove duplicate button
    2) use Advanced filter and to copy the unique records to a new column
    3) use an intermediate column with a countif formula to display the count of the items and then filter on this for the count >1 and delete those rows. You could then delete the intermediate column and autofilter

    Steve
    I have Excel 2003

  8. #8
    Lounger
    Join Date
    Feb 2011
    Posts
    28
    Thanks
    0
    Thanked 10 Times in 8 Posts
    Apologies. I'd cut a bit too much from the original, and while it worked with that test sample, it doesn't work in all circumstances... This should work properly now:

    Sub RemoveDups()
    '
    Dim i As Long
    Dim lngRows As Long
    Dim strA As String 'to compare values
    Dim strB As String

    'Find last row

    ActiveCell.SpecialCells(xlLastCell).Select
    lngRows = Selection.Row

    For i = 1 To lngRows

    strA = Range("A" & i).Text & Range("B" & i).Text
    strB = Range("A" & (i + 1)).Text & Range("B" & (i + 1)).Text

    If strA = "" And strB = "" Then End
    If strA = strB Then
    Do Until strA <> strB
    Rows(i + 1).Select
    Selection.Delete Shift:=xlUp
    lngRows = lngRows - 1
    strB = Range("A" & (i + 1)).Text & Range("B" & (i + 1)).Text
    Loop
    Rows(i).Select
    Selection.Delete Shift:=xlUp
    lngRows = lngRows - 1
    i = i - 1
    End If
    Next i
    Range("A1").Select
    End Sub

    Reminder to self: Test properly in future!

  9. #9
    Star Lounger
    Join Date
    Dec 2009
    Location
    Buenos Aires, Argentina
    Posts
    54
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Excuse me, but it doesn't work...

  10. #10
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Options 2 and 3 will work with XL2003...

    Steve

  11. #11
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    I am aassuming from your list of 2483, that you want to remove the duplicates and keep an original of each name (2361) instead of keeping the unique ones (2241) as you mention. [for example is you have the list a,b,b,b,c,d,d,e the original list would be a,b,c,d,e, where the unique would be a,c,e]
    In the case of keeping 1 of each name, you could use the code [this essentially does my option 3 from above using the Autofilter]
    Code:
    Option Explicit
    Sub KeepOriginals()
      Dim lLastRow As Long
      Dim sRange As String
      Rows("1:1").Insert Shift:=xlDown
      Columns("A:A").Insert Shift:=xlToRight
      Range("A1:B1") = Array("Temp", "Email")
      lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
      sRange = "A2:A" & lLastRow
      Range(sRange).FormulaR1C1 = "=MATCH(RC[1],C[1],0)=ROW()"
      With Columns("A:A")
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:="FALSE"
        Range(sRange).Delete Shift:=xlUp
        .AutoFilter
        .EntireColumn.Delete
      End With
      Rows("1:1").EntireRow.Delete
    End Sub
    If you want to obtain a the unique items, it is the same code, but the formula and filter criteria are different

    Code:
    Option Explicit
    Sub KeepUniques()
      Dim lLastRow As Long
      Dim sRange As String
      Rows("1:1").Insert Shift:=xlDown
      Columns("A:A").Insert Shift:=xlToRight
      Range("A1:B1") = Array("Temp", "Email")
      lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
      sRange = "A2:A" & lLastRow
      Range(sRange).FormulaR1C1 = "=COUNTIF(C[1],RC[1])"
      With Columns("A:A")
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=">1"
        Range(sRange).Delete Shift:=xlUp
        .AutoFilter
        .EntireColumn.Delete
      End With
      Rows("1:1").EntireRow.Delete
    End Sub
    Test on a copy of the data to ensure it does what you want...
    Steve

  12. #12
    Lounger
    Join Date
    Feb 2011
    Posts
    28
    Thanks
    0
    Thanked 10 Times in 8 Posts
    This should work for anything where column A and column B both match (as per your sample code). Steve's option 3 will also work, or if you post a sample section of your spreadsheet I can examine why the code doesn't work.

  13. #13
    Star Lounger
    Join Date
    Dec 2009
    Location
    Buenos Aires, Argentina
    Posts
    54
    Thanks
    0
    Thanked 0 Times in 0 Posts
    It works, both!

    Many, many thanks.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •