Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 19

Thread: Help remove duplicate rows

  1. #1
    Board Regular wilkisa's Avatar
    Join Date
    Apr 2002
    Location
    Decatur IL, USA
    Posts
    635
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    We receive a large sheet from an outside source. It has 157 columns (A - FA), and 4041 rows.

    The vendor name is in column C and the vendor address is in column D. I need a macro that will find duplicates and delete the entire row.

    Example:

    Col. C...Wonder Widgets...Col. D...123 Main
    Col. C...Wonder Widgets...Col. D...456 Elm
    Col. C...Wonder Widgets...Col. D...123 Main

    I want to delete only the second occurance of Wonder Widgets at 123 Main. The other two Wonder Widgets should remain in the sheet.

    Thanks in advance for any help,
    Shirlene

  2. #2
    Board Regular
    Join Date
    Feb 2002
    Location
    Southfield,MI USA
    Posts
    2,312
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    G'day,

    The Advanced Filter feature has a way to copy "unique records only" - this is a good method if you don't need a macro.

    Hope that helps,
    Adam

  3. #3
    Board Regular wilkisa's Avatar
    Join Date
    Apr 2002
    Location
    Decatur IL, USA
    Posts
    635
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    I have tried the AutoFilter unique records feature but it won't work for these sheets. The problem is that the vendor who sends us the sheet has numbered each record with duplicate records having different numbers.

    Any other suggestions?

  4. #4
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Are you opposed to using a VBA macros?
    If not, what is the first row your data begins on?

    Tom


    [ This Message was edited by: TsTom on 2002-04-23 04:41 ]

  5. #5
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi again.
    If you need help with this please repost.
    Assumes data starts on row 2...

    Sub NoDups()
    Dim RowCntr As Long, FromRowCntr As Long, LastRow As Long
    Dim CompareStr
    Dim FirstString As String, SecondString As String
    On Error Resume Next
    Range("A2:FZ20000").Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    LastRow = Range("C1:C" & Range("C65536").End(xlUp).Row).Rows.Count
    For RowCntr = 2 To LastRow
    For FromRowCntr = RowCntr + 1 To LastRow
    FirstString = Range("C" & RowCntr) & Range("D" & RowCntr)
    SecondString = Range("C" & FromRowCntr) & Range("D" & FromRowCntr)
    CompareStr = StrComp(FirstString, SecondString, 1)
    If CompareStr = 0 Then
    Rows(FromRowCntr & ":" & FromRowCntr).Delete Shift:=xlUp
    FromRowCntr = FromRowCntr - 1
    End If
    Next
    Next
    End Sub
    Thanks,
    Tom

    [ This Message was edited by: TsTom on 2002-04-23 05:09 ]

  6. #6
    Board Regular wilkisa's Avatar
    Join Date
    Apr 2002
    Location
    Decatur IL, USA
    Posts
    635
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    The macro works great on sheets that are a few hundred rows. However, it dies while working in sheets of a few thousand rows. I ran it for 20 minutes on my sheet with 4041 rows and finally found that Excel stopped responding. Any ideas?

  7. #7
    Board Regular
    Join Date
    Feb 2002
    Location
    Southfield,MI USA
    Posts
    2,312
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi again,

    I guess you could always go with a semi-manual method (a few steps but not too horrible):

    1: insert a new column somewhere and on the 2nd row use the formula =C2&D2 (copy down).

    The idea is to catch the criteria for a unique record - you may wish to add more cells to the concatenated to ensure a good criteria. For the example's sake I'll assume you type this formula in C2.

    2. Insert a 2nd new column with the formula: =countif($C$2:C2,C2) (copy down again).

    3. Copy and paste these columns as values

    4. Sort by this numbered column, then manually delete any entries >1

    5. (optional) resort by their initial order.

    Hope that helps,
    Adam

  8. #8
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi
    Will need a sample sheet...
    Unless someone can find out why my code is doing what you said.
    I'm assuming that the deletion of the rows might be sending it into an endless loop.
    Maybe try this as an alternative...

    Sub NoDups()
    Dim RowCntr As Long, FromRowCntr As Long, LastRow As Long
    Dim CompareStr
    Dim FirstString As String, SecondString As String
    On Error Resume Next
    Range("A2:FZ20000").Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    LastRow = Range("C1:C" & Range("C65536").End(xlUp).Row).Rows.Count
    For RowCntr = 2 To LastRow
    For FromRowCntr = RowCntr + 1 To LastRow
    FirstString = Range("C" & RowCntr) & Range("D" & RowCntr)
    SecondString = Range("C" & FromRowCntr) & Range("D" & FromRowCntr)
    CompareStr = StrComp(FirstString, SecondString, 1)
    If CompareStr = 0 Then
    Rows(FromRowCntr & ":" & FromRowCntr).ClearContents
    FromRowCntr = FromRowCntr - 1
    End If
    Next
    Next
    For RowCntr = LastRow To 2
    If Range("C" & RowCntr) = "" Then _
    Rows(RowCntr & ":" & RowCntr).Delete Shift:=xlUp
    Next
    End Sub
    If that does not work and no one else provides a solution, then I will need a sample worksheet to test it out.
    Tom

  9. #9
    Board Regular
    Join Date
    Mar 2002
    Location
    Cincinnati, Ohio, USA
    Posts
    6,824
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi
    I failed to adjust LastRow when a row was deleted.
    Hence, the forever loop...
    As an added precaution, I added this line of code:
    If Len(Trim(FirstString)) = 0 Then Exit Sub
    It is commented out. If you are still having problems then
    make this line active in the code.
    Sub NoDups()
    Dim RowCntr As Long, FromRowCntr As Long, LastRow As Long
    Dim CompareStr
    Dim FirstString As String, SecondString As String
    On Error Resume Next
    Range("A2:FZ20000").Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    LastRow = Range("C1:C" & Range("C65536").End(xlUp).Row).Rows.Count
    For RowCntr = 2 To LastRow
    FirstString = Range("C" & RowCntr) & Range("D" & RowCntr)
    'If Len(Trim(FirstString)) = 0 Then Exit Sub
    For FromRowCntr = RowCntr + 1 To LastRow
    SecondString = Range("C" & FromRowCntr) & Range("D" & FromRowCntr)
    CompareStr = StrComp(FirstString, SecondString, 1)
    If CompareStr = 0 Then
    Rows(FromRowCntr & ":" & FromRowCntr).Delete Shift:=xlUp
    FromRowCntr = FromRowCntr - 1
    LastRow = LastRow - 1
    End If
    Next
    Next
    End Sub
    Thanks,
    Tom

  10. #10

    Join Date
    Mar 2002
    Posts
    15
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    A macro can be created with the macro recorder by recording the following steps (note : it has been assumed that only column D needs to be checked for duplicates on the basis that a particular address will not have more than one customer name - if this is not the case, post again) :-

    - Insert a column before column D
    - In the inserted column, select from D1 down to the last row with data in column E
    - Type in the formula =IF(COUNTIF($E$1:E1,E1)>1,1,"") and press Ctrl+Enter
    - Go to Edit>GoTo>Special>Formula>Numbers and click OK
    - Go to Edit>Delete>EntireRow
    - Delete Column D


    Here's a cleaned-up version of the recorded macro :-

    Sub Delete_Duplicates()
    Application.ScreenUpdating=False
    Columns(4).Insert
    With Range([E1], [E65536].End(xlUp)).Offset(0, -1)
    .FormulaR1C1 = "=IF(COUNTIF(R1C5:RC[1],RC[1])>1,1,"""")"
    On Error Resume Next
    .SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
    On Error GoTo 0
    .EntireColumn.Delete
    End With
    End Sub


    [ This Message was edited by: Brabantio on 2002-04-23 19:30 ]

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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