Optimize this VBA lookup loop in Excel

Can you try this for me? I have commented the code so that you will not have a problem understanding it. Also check how much time it takes for 10k+ rows

Logic

1. Store search values in array 1
2. Store destination values in array 2
3. Loop through the first array and check if it is present in the second array. If present, clear it
4. Clear the search values from sheet1
5. Output the array to the sheet1
6. Sort Col A so that the blanks go down.

Code

Sub Sample()
    Dim wbMatch As Worksheet, wbDestSheet As Worksheet
    Dim lRow As Long, i As Long
    Dim MArr As Variant, DArr As Variant
    Dim strSheetName As String
    Dim rng As Range

    strSheetName = "Sheet2" '"Week " & IsoWeekNum(Format(Date)) - 1

    '~~> Set your worksheets
    Set wbMatch = Sheets("MatchData")
    Set wbDestSheet = Sheets(strSheetName)

    '~~> Store search values in 1st array
    With wbMatch
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        Set rng = .Range("A2:A" & lRow)
        MArr = rng.Value
    End With

    '~~> Store destination values in the 2nd array
    With wbDestSheet
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        DArr = .Range("A2:A" & lRow).Value
    End With

    '~~> Check if the values are in the other array
    For i = LBound(MArr) To UBound(MArr)
        If IsInArray(MArr(i, 1), DArr) Then MArr(i, 1) = ""
    Next i

    With wbMatch
        '~~> Clear the range for new output
        rng.ClearContents

        '~~> Output the array to the worksheet
        .Range("A2").Resize(UBound(MArr), 1).Value = MArr

        '~~> Sort it so that the blanks go down
        .Columns(1).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    End With
End Sub

'~~> function to check is a value is in another array
Function IsInArray(stringToBeFound As Variant, arr As Variant) As Boolean
    Dim j As Long

    For j = 1 To UBound(arr, 1)
        On Error Resume Next
        IsInArray = Application.Match(stringToBeFound, Application.Index(arr, , i), 0)
        On Error GoTo 0
        If IsInArray = True Then Exit For
    Next
End Function

Edit

Another way. Based on the sample file, this code runs in approx 1 minute.

Start : 8/4/2016 08:59:36 PM
End : 8/4/2016 09:00:47 PM

Logic:

It uses CountIf to check for duplicates and then deletes the duplicates using .Autofilter

Sub Sample()
    Dim wbMatch As Worksheet, wbDestSheet As Worksheet
    Dim lRow As Long
    Dim strSheetName As String
    Dim rng As Range

    Debug.Print "Start : " & Now

    strSheetName = "Week " & ISOWeekNum(Format(Date)) - 1

    '~~> Set your worksheets
    Set wbMatch = Sheets("MatchData")
    Set wbDestSheet = Sheets(strSheetName)

    '~~> Store search values in 1st array
    With wbMatch
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        .Columns(2).Insert
        Set rng = .Range("B2:B" & lRow)

        lRow = wbDestSheet.Range("A" & wbDestSheet.Rows.Count).End(xlUp).Row

        rng.Formula = "=COUNTIF('" & strSheetName & "'!$A$1:$A$" & lRow & ",A2)"
        DoEvents

        rng.Value = rng.Value
        .Range("B1").Value = "Temp"

        'Remove any filters
        .AutoFilterMode = False

        With .Range("A1:E" & lRow) 'Filter, offset(to exclude headers) and delete visible rows
            .AutoFilter Field:=2, Criteria1:=">0"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        'Remove any filters
        .AutoFilterMode = False

        .Columns(2).Delete
    End With

    Debug.Print "End : " & Now
End Sub