Results 1 to 5 of 5
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts

    macro to delete Duplicate records

    I have a spreadsheet that has duplicate refrence numbers in column H. I have written code to remove the duplicate record and to retain unique records only. I need the code amended so that where a duplicate reference appears wirth an Alpha prefix, the duplicate reference staring with an Alpha character for ef F1048 is not deleted. Your assistance in this regard will be most appreciated

    Code:
     
    Public Sub DeleteDuplicateRows()'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' DeleteDuplicateRows' This will delete duplicate records, based on the Active Column. That is,' if the same value is found more than once in the Active Column, all but' the first (lowest row number) will be deleted.'' To run the macro, select the entire column you wish to scan for' duplicates, and run this procedure.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Dim R As LongDim N As LongDim V As VariantDim rng As RangeOn Error GoTo EndMacroApplication.ScreenUpdating = FalseApplication.Calculation = xlCalculationManualSet rng = Application.Intersect(ActiveSheet.UsedRange, _ ActiveSheet.Columns(ActiveCell.Column))Application.StatusBar = "Processing Row: " & Format(rng.Row, "#,##0")N = 0For R = rng.Rows.Count To 2 Step -1If R Mod 500 = 0 Then Application.StatusBar = "Processing Row: " & Format(R, "#,##0")End IfV = rng.Cells(R, 1).ValueIf V = vbNullString Then If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End IfElse If Application.WorksheetFunction.CountIf(rng.Columns(1), V) > 1 Then rng.Rows(R).EntireRow.Delete N = N + 1 End IfEnd IfNext REndMacro:Application.StatusBar = FalseApplication.ScreenUpdating = TrueApplication.Calculation = xlCalculationAutomaticMsgBox "Duplicate Rows Deleted: " & CStr(N)End Sub__________________
    Attached Files Attached Files
    Last edited by HowardC; 2011-04-19 at 10:16. Reason: adding code

  2. #2
    3 Star Lounger
    Join Date
    Nov 2002
    Location
    New York, New York, USA
    Posts
    266
    Thanks
    0
    Thanked 19 Times in 19 Posts
    HowardC:

    Alternate solution (not using Macro). Use Filter - Advance Filter. In the Dialog Box check the unique records box. Define the Criteria for Col H to be '=*
    Copy the results to a different location.
    On the test I ran it gave the results expected. The benefit is you keep the original data and create the desired results in a different location. If this done repeatedly create a macro that runs the advance filter based on the standard criteria and use the macro to obtain the unique records.
    Regards,
    Tom D

  3. #3
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Tom

    Thanks for the reply. I want to retain the unique records i.e to remove one of the duplicate retains as well as to retain those references that starts with an Alpha character even if there are duplicates starting with an Alpha character. Your assistance will be most appreciated

  4. #4
    3 Star Lounger
    Join Date
    Nov 2002
    Location
    New York, New York, USA
    Posts
    266
    Thanks
    0
    Thanked 19 Times in 19 Posts
    HowardC

    I know you want to delete duplicate records, but what I think is better is to use advanced filter which will produce the end result you desire. In the attached workbook I have put in a few formulas, of course you could combine into one more complex formula.

    Most important any beginning Alpha even if itís an exact duplicate is kept.
    The output area AA100 is an exact copy of the original data but there are no unwanted duplicate records.

    If you really want to delete the original data just add a few lines to the Macro to Select MyRange and delete it, then go to AA100 and use the UsedRange command and copy and paste the results back to the original place, or even better copy the new range to Sheet2 and you have the original and the revised.

    I tested a few different variations and the filtered data met the results you wanted.

    Hope this helps.

    Regards,

    Tom Duthie
    Attached Files Attached Files

  5. #5
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,423
    Thanks
    126
    Thanked 5 Times in 5 Posts
    Hi Tom

    Thanks for the help, much appreciated

    Regards

    Howard

Posting Permissions

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