No announcement yet.

Remove All But 1st Of Duplicate Rows

  • Filter
  • Time
  • Show
Clear All
new posts

  • Remove All But 1st Of Duplicate Rows

    Hi there ive got a spreadsheet with records such as this

    james - smith - leeds- 01535 - 26/02/1983 - bd21 6ls
    steven - smith - bradford - 213789 - 28/01/1982 - bd33 5th
    james - smith - leeds - 01535 - 26/02/1983 - bd21 6ls
    steven - king - manchester - 213789 - 28/01/1982
    andrew - wright - bingley - 36473 - 12/01/1981 - bd23 689

    what im trying to do is to check all of the rows for duplicates in such a way that (if any row has the matching colums 1,2,5 and 6 then all but 1 of the rows will be deleted.

    i have a few thousand entries and am just trying to get rid of all the duplicate rows. The problem is that the duplicate rows are not IDENTICAL for instance soime of them may have spelling mistakes hence i cannot just do a straight forward if row = row then delete.

    im not sure how to get this done so any help is really appreciated


  • #2
    Re: Removing Duplicates- Multiple Matching

    Hi lazynewt,

    Welcome to board!!


    Sub kTest()
    Dim a, s As String, i As Long, w(), c As Long, n As Long
    a = Range("a1").CurrentRegion.Offset(1).Resize(, 6)
    ReDim w(1 To UBound(a, 1), 1 To UBound(a, 2))
    With CreateObject("Scripting.dictionary")
    .comparemode = vbTextCompare
    For i = 1 To UBound(a, 1)
    s = a(i, 1) & ";" & a(i, 2) & ";" & a(i, 5) & ";" & a(i, 6)
    If Not .exists(s) Then
    n = n + 1
    For c = 1 To UBound(a, 2)
    w(n, c) = a(i, c)
    .Add s, n
    End If
    End With
    With Range("a1")
    .Offset(1).Resize(n, UBound(a, 2)).Value = w
    End With
    End Sub




    • #3
      Re: Removing Duplicates- Multiple Matching



      • #4
        Re: Remove All But 1st Of Duplicate Rows

        Hi appologies for the late response.
        that code is perfect thank you.

        another route i was looking into was to concatenate lastname+dob+post code. This is the routine i ended up with.

        1. create new column and concatenate b+d+e into it
        2. create new column next to this and use


        "where a is your column"

        this will then give duplicate records as a numerical value of 2.

        3. Use auto filter to only show records that match 2.
        4. copy these records to a new excel doc.
        5. use sort to arrange the data into pairs.
        6. use this script to delete every other row.
        Sub Delete_Every_Other_Row()
           ' Dimension variables.
           Y = False              ' Change this to True if you want to
                                  ' delete rows 1, 3, 5, and so on.
           I = 1
           Set xRng = Selection
           ' Loop once for every row in the selection.
           For xCounter = 1 To xRng.Rows.Count
               ' If Y is True, then...
               If Y = True Then
                   ' ...delete an entire row of cells.
               ' Otherwise...
                   ' ...increment I by one so we can cycle through range.
                   I = I + 1
               End If
               ' If Y is True, make it False; if Y is False, make it True.
               Y = Not Y
           Next xCounter
        End Sub
        then combine both sheets and were left with and voila.

        NOTE:- this will only work if there are only 2 of each record. For cases that records are duplicated more than once other steps will be needed

        I will be needing to do this again and will be using the code you provided to do so Krishnakumar. Thank you very much for your help.

        pps. not sure if i am ment to put formula in code i think i may of read something about not doing this so if that is the case please forgive me.
        Last edited by Dave Hawley; August 15th, 2008, 10:39.


        • #5

          Re: Remove All But 1st Of Duplicate Rows

          No, use code tags ONLY on code, not formulae.