I have Sheet1 and Sheet2 which I need to compare. In Sheet1 I need to delete those rows which are in Sheet2 and keep only those which are not or which are different (one or more values in 7columns). I have written following code so far, but it works so slowly, because I have more then 13000 rows in Sheet1. Is there any possibility to rewrite this code to make it faster?

Option Explicit

Sub DeleteDuplicates()
Application.ScreenUpdating = False

Dim startRow As Integer
startRow = 1

Dim row As Integer
row = startRow

Dim bRow As Integer

Do While (Worksheets("Sheet1").Range("A" & row).Value <> "")

    Dim aVal As String
    Dim bVal As String
    Dim cVal As String
    Dim dVal As String
    Dim eVal As String
    Dim fVal As String
    Dim gVal As String

    aVal = Worksheets("Sheet1").Range("A" & row).Value
    bVal = Worksheets("Sheet1").Range("B" & row).Value
    cVal = Worksheets("Sheet1").Range("C" & row).Value
    dVal = Worksheets("Sheet1").Range("D" & row).Value
    eVal = Worksheets("Sheet1").Range("E" & row).Value
    fVal = Worksheets("Sheet1").Range("F" & row).Value
    gVal = Worksheets("Sheet1").Range("G" & row).Value

    bRow = startRow

    Do While (Worksheets("Sheet2").Range("A" & bRow).Value <> "")

    Dim aVal2 As String
    Dim bVal2 As String
    Dim cVal2 As String
    Dim dVal2 As String
    Dim eVal2 As String
    Dim fVal2 As String
    Dim gVal2 As String

    aVal2 = Worksheets("Sheet2").Range("A" & bRow).Value
    bVal2 = Worksheets("Sheet2").Range("B" & bRow).Value
    cVal2 = Worksheets("Sheet2").Range("C" & bRow).Value
    dVal2 = Worksheets("Sheet2").Range("D" & bRow).Value
    eVal2 = Worksheets("Sheet2").Range("E" & bRow).Value
    fVal2 = Worksheets("Sheet2").Range("F" & bRow).Value
    gVal2 = Worksheets("Sheet2").Range("G" & bRow).Value

    If (aVal = aVal2 And bVal = bVal2 And cVal = cVal2 And dVal = dVal2 And eVal = eVal2 And fVal = fVal2 And gVal = gVal2) Then

        Worksheets("Sheet1").Rows(row).Delete ' we found a traitor, feed em to the sharks
        row = row - row
        Exit Do

    End If

    bRow = bRow + 1

    Loop

row = row + 1
Loop

End Sub
Many thanks