delete that entire row if column d has duplicates data

hdgfss

New Member
Joined
Aug 29, 2019
Messages
20
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

Well-known Member
Joined
Feb 26, 2007
Messages
5,096
Office Version
2019
Platform
Windows
Code:
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

New Member
Joined
Aug 29, 2019
Messages
20
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

Well-known Member
Joined
Feb 26, 2007
Messages
5,096
Office Version
2019
Platform
Windows
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

New Member
Joined
Aug 29, 2019
Messages
20
i mean to say that after the data is deleted save that file it should not have duplicate
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
5,096
Office Version
2019
Platform
Windows
After the last line of code before End Sub insert the following lines
Code:
ActiveWorkbook.Save
ActiveWorkbook.Close
 

Forum statistics

Threads
1,084,753
Messages
5,379,663
Members
401,620
Latest member
Ankur Teotia

Some videos you may like

This Week's Hot Topics

Top