Macro To Delete Entire Row If Dublicate Is Found

Try this code

Sub delete_dups()
Dim i As Long, lrow As Long

Application.ScreenUpdating = False

With Worksheets("Sheet1")
    .Cells.Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range("B2") _
        , Order2:=xlAscending, key3:=.Range("G2"), order3:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
       
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = lrow To 2 Step -1
        If .Range("A" & i).Value = .Range("A" & i - 1).Value And .Range("B" & i).Value = .Range("B" & i - 1).Value And _
            .Range("G" & i).Value = .Range("G" & i - 1).Value Then
            .Rows(i).Delete
        End If
    Next i
End With

Application.ScreenUpdating = True

End Sub

Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
Choose Insert | Module
Where the cursor is flashing, choose Edit | Paste

To run the Excel VBA code:
Choose Tools | Macro | Macros
Select a macro in the list, and click the Run button

Hi SilverFox,

See how this goes:

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au

    Dim objMyUniqueEntries As Object
    Dim lngRowStart As Long, _
        lngRowEnd As Long, _
        lngMyRow As Long, _
        lngMyCounter As Long
    Dim rngDelRange As Range
    
    Set objMyUniqueEntries = CreateObject("Scripting.Dictionary")
    lngRowStart = 2 'Starting row number for the data. Change to suit.
    lngRowEnd = Range("A:X").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Application.ScreenUpdating = False
    
    For lngMyRow = lngRowStart To lngRowEnd
        If objMyUniqueEntries.exists(CStr(Range("A" & lngMyRow) & Range("B" & lngMyRow) & Range("G" & lngMyRow))) = False Then
            lngMyCounter = lngMyCounter + 1
            objMyUniqueEntries.Add CStr(Range("A" & lngMyRow) & Range("B" & lngMyRow) & Range("G" & lngMyRow)), lngMyCounter
        Else
            If rngDelRange Is Nothing Then
                Set rngDelRange = Cells(lngMyRow, "A")
            Else
                Set rngDelRange = Union(rngDelRange, Cells(lngMyRow, "A"))
            End If
        
        End If
    Next lngMyRow
    
    Set objMyUniqueEntries = Nothing
    
    'If the 'rngDelRange' range has been set, then...
    If Not rngDelRange Is Nothing Then
        '...delete the row(s) from it.
        rngDelRange.EntireRow.Delete
        Application.ScreenUpdating = True
        MsgBox "The duplicate rows have now been deleted.", vbInformation, "Delete Duplicate Row Editor"
        Set rngDelRange = Nothing
    'Else...
    Else
        '...display a message that no rows were deleted as they were all unique.
        Application.ScreenUpdating = True
        MsgBox "There were no rows deleted as no duplicates were found.", vbExclamation, "Delete Duplicate Row Editor"
    End If
    
End Sub

Regards,

Robert

What error do you get and which code line is highlighted?

Thanks for letting us know and you're welcome.