Results 1 to 7 of 7
  1. #1
    2 Star Lounger
    Join Date
    Dec 2003
    Location
    Perth, Western Australia, Australia
    Posts
    128
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Deleting Duplicate Rows (2002)

    Lounger's, I have used the macro below from the Pearson Site which works great, however, I need to delete the second occurrence of the duplicate row. This deletes the first occurrence - I'm sure this is a simple change to the macro - when you know how. Any thoughts?

    Public Sub DeleteDuplicateRows()
    '
    ' This macro deletes duplicate rows in the selection. Duplicates are
    ' counted in the COLUMN of the active cell.

    Dim Col As Integer
    Dim r As Long
    Dim C As Range
    Dim N As Long
    Dim V As Variant
    Dim Rng As Range

    On Error GoTo EndMacro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Col = ActiveCell.Column

    If Selection.Rows.Count > 1 Then
    Set Rng = Selection
    Else
    Set Rng = ActiveSheet.UsedRange.Rows
    End If

    N = 0
    For r = Rng.Rows.Count To 1 Step -1
    V = Rng.Cells(r, 1).Value
    If Application.WorksheetFunction.CountIf(Rng.Columns( 1), V) > 1 Then
    Rng.Rows®.EntireRow.Delete
    N = N + 1
    End If
    Next r

    EndMacro:

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    End Sub

  2. #2
    5 Star Lounger
    Join Date
    Oct 2002
    Location
    Wellington, Wellington, New Zealand
    Posts
    621
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Deleting Duplicate Rows (2002)

    So far as I can see, (confirmed by my testing) is that it deletes all occurences but the first.

  3. #3
    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

    Re: Deleting Duplicate Rows (2002)

    Yes as far as I can see, it starts at the bottom of the list and checks to see if there are any duplicates in the column. (it only checks in what the active column was when the macro was run) If yes it deletes the row, if not it moves up the rows. At the end you only have 1 occurence since the first occurrence is not a "duplicate".

    Could you post a simple example of something that does not work?

    Steve

  4. #4
    2 Star Lounger
    Join Date
    Dec 2003
    Location
    Perth, Western Australia, Australia
    Posts
    128
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Deleting Duplicate Rows (2002)

    Guys thanks for the replies - sorry about the delay in acknowledging your feedback.

    Given that the macro works from the bottom of the list, is there a way that the macro could be modified to delete the second occurrence no the first?

    Any thoughts

  5. #5
    3 Star Lounger Jim Cone's Avatar
    Join Date
    Feb 2002
    Location
    Portland, Oregon, USA
    Posts
    238
    Thanks
    0
    Thanked 3 Times in 3 Posts

    Re: Deleting Duplicate Rows (2002)

    Dean,

    Only tested a couple of times, see how it works for you...

    '------------------------------------------------
    Public Sub DeleteDuplicateRows()
    '
    ' This macro deletes duplicate rows in the selection. Duplicates are
    ' counted in the COLUMN of the active cell.
    ' Modified by Jim Cone 02/23/2004 by adding a Collection object to
    ' compare cell values. Variables C, N and Col deleted.
    ' Variable V changed from Variant to String.

    Dim r As Long
    Dim V As String
    Dim Rng As Range
    Dim colDupes As Collection
    On Error GoTo EndMacro

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set colDupes = New Collection

    If Selection.Rows.Count > 1 Then
    Set Rng = Selection
    Else
    Set Rng = ActiveSheet.UsedRange.Rows
    End If

    For r = Rng.Rows.Count To 1 Step -1
    V = CStr(Rng.Cells(r, 1).Value2)
    On Error Resume Next
    colDupes.Add vbNullString, V
    If Err.Number <> 0 Then
    Rng.Rows®.EntireRow.Delete
    Err.Clear
    End If
    On Error GoTo EndMacro
    Next r

    EndMacro:
    Set Rng = Nothing
    Set colDupes = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    End Sub
    '----------------------------------------------------------------

    Regards,
    Jim Cone
    San Francisco, CA

  6. #6
    2 Star Lounger
    Join Date
    Dec 2003
    Location
    Perth, Western Australia, Australia
    Posts
    128
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Deleting Duplicate Rows (2002)

    Jim - Thats works just fine - Thanks for your help

  7. #7
    3 Star Lounger
    Join Date
    Jul 2001
    Location
    Long Beach, California, USA
    Posts
    233
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Deleting Duplicate Rows (2002)

    I love Woody's. I needed to test a large list for duplicate values. Copied and tweaked this code to change the interior color for dups instead of deleting the row. Worked like a charm.

Posting Permissions

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