delete that entire row if column d has duplicates data

[hdgfss]

two files are opened
my vba placed file where i will place the vba code and second is the file that has data so look that file and if column d of that file has duplicate data then delete that entire row and keep the rest data
do not close any file and save the deleted entire row data file

 

[alansidman]

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 Long
    Dim n As Long
    Dim v As Variant
    Dim rng As Range


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




    Set rng = Application.Intersect(ActiveSheet.UsedRange, _
                                    ActiveSheet.Columns(ActiveCell.Column))


    Application.StatusBar = "Processing Row: " & Format(rng.Row, "#,##0")


    n = 0
    For r = rng.Rows.Count To 2 Step -1
        If r Mod 500 = 0 Then
            Application.StatusBar = "Processing Row: " & Format(r, "#,##0")
        End If


        v = rng.Cells(r, 1).Value
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
        ' Rather than pass in the variant, you need to pass in vbNullString explicitly.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If v = vbNullString Then
            If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then
                rng.Rows(r).EntireRow.Delete
                'rng.Rows(r).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
                n = n + 1
            End If
        Else
            If Application.WorksheetFunction.CountIf(rng.Columns(1), v) > 1 Then
                rng.Rows(r).EntireRow.Delete
                'rng.Rows(r).EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
                n = n + 1
            End If
        End If
    Next r


EndMacro:


    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Duplicate Rows Deleted: " & CStr(n)




End Sub

 

[hdgfss]

Sir this code is pefect but what i need is
two files are opened, my vba placed file where i will place the vba code and second is the file that has data so look that file and if column d of that file has duplicate data then delete that entire row and keep the rest data
do not close any file and save the deleted entire row data file
and to make ur code workable i have to copy the data from column d to vab placed file and then i have to select that column then i have to run this macro so its time consuming

 

[alansidman]

I am confused by your response. In your first post you ask to have the duplicate deleted. Now are you saying you want to save the duplicate to a new file? You are not clear in your explanation. Please provide an example of what you have and what you want to happen. I can run this code from my personal.xlsb file and it will delete duplicates in whatever file is open and the column highlighted. I don't understand your issues as that appears to be what you asked for in your first post.

 

[hdgfss]

i mean to say that after the data is deleted save that file it should not have duplicate

 

[alansidman]

After the last line of code before End Sub insert the following lines

ActiveWorkbook.Save
ActiveWorkbook.Close