Compare two columns in an Excel spreadsheet I have a VBA code that compares values in two columns (Column A &amp; B), which runs slow. Please advise me the changes to make it run fast

The below code works just fine, but is running slow. Please advise me on how to make it run fast

 Sub compare()
       Dim ListA As Range
       Dim ListB As Range
       Dim c As Range
       Call Unprotect
       Set ListA = Range("A2:A1048576")
       Set ListB = Range("B2:B1048576")

       Application.ScreenUpdating = False

       Range("C1").Value = "Files in A that are NOT in B"
       Range("D1").Value = "Files in B that are Not in A"
       Range("E1").Value = "Matching Files"


       For Each c In ListA
       If Application.CountIf(ListB, c) = 0 Then
       Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, "C").Value = c
       End If
       Next c

       For Each c In ListA
       If Application.CountIf(ListB, c) &gt;= 1 Then
       Cells(Cells(Rows.Count, "E").End(xlUp).Row + 1, "E").Value = c
       End If
       Next c

       For Each c In ListB
       If Application.CountIf(ListA, c) = 0 Then
       Cells(Cells(Rows.Count, "D").End(xlUp).Row + 1, "D").Value = c
       End If
       Next c



     Application.ScreenUpdating = True

     Call Protect
     End Sub


Any code changes to make the code run fast will be appreciated. Thanks
I'm sure you can further optimize the code, but this will definitely run faster. 

It will run faster for a number of reasons, firstly I've combined one of your loops so you only have two For Loops, the second reason is that the code won't be looking at every cell in the worksheet, but it will find the last row with data and loop until then:

Sub compare()
    Dim ListA As Range
    Dim ListB As Range
    Dim c As Range
    Call Unprotect

    ListARange = Cells(Rows.Count, "A").End(xlUp).Row 'find the last row with data on column A
    ListBRange = Cells(Rows.Count, "B").End(xlUp).Row 'find the last row with data on column B

    Set ListA = Range("A2:A" &amp; ListARange) 'set your range only until the last row with data
    Set ListB = Range("B2:B" &amp; ListBRange)
    Application.ScreenUpdating = False

    Range("C1").Value = "Files in A that are NOT in B"
    Range("D1").Value = "Files in B that are Not in A"
    Range("E1").Value = "Matching Files"


    For Each c In ListA
        If Application.CountIf(ListB, c) = 0 Then
            Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, "C").Value = c
        ElseIf Application.CountIf(ListB, c) &gt;= 1 Then
            Cells(Cells(Rows.Count, "E").End(xlUp).Row + 1, "E").Value = c
        End If
    Next c

    For Each c In ListB
        If Application.CountIf(ListA, c) = 0 Then Cells(Cells(Rows.Count, "D").End(xlUp).Row + 1, "D").Value = c
    Next c

    Application.ScreenUpdating = True

    Call Protect
End Sub