Update table via deleting records

Option Explicit
Dim clearedData As Range, cell As Range
Dim deletedataCounter As Byte
Sub updateDat()
    Set clearedData = Sheets(2).Range("A2:A" & Sheets(2).Range("A2").CurrentRegion.Rows.Count)
    [a1].Select
    deletedataCounter = 0
    Do
        ActiveCell.Offset(1, 0).Select
            For Each cell In clearedData
                If ActiveCell.Value = cell.Value Then
                  Range(ActiveCell.Address, ActiveCell.Offset(0, 2)).Select
                  Selection.Delete xlShiftUp
                  deletedataCounter = deletedataCounter + 1
                End If
            Next cell
    Loop Until ActiveCell.Value = ""
    MsgBox deletedataCounter & "Cheques Cleared" & [a1].CurrentRegion.Rows.Count & "Pending"
    Set clearedData = Nothing
End Sub

https://drive.google.com/file/d/0B23eJ2xd9ODydDRQd1BhcEJDVEk/edit?usp=sharing