Please help me modify an exising macro to recognise duplicates

I have two columns of data in column a and b and I am using the following macro to find the difference in each of the columns.

Sub Compare()
 Dim ListA As Range
 Dim ListB As Range
 Dim C As Range
 Set ListA = Range("A1:A4000")
 Set ListB = Range("B1:B4000")
 Range("C1").Value = "In A not in B"
 Range("D1").Value = "In B not in A"
 Range("E1").Value = "Count of A"
 Range("F1").Value = "Count of B"
 For Each C In ListA
 If C.Value <> "" Then
 Range("E2").Value = Range("E2").Value + 1
 If Application.CountIf(ListB, C) = 0 Then
 Cells(Cells(Rows.count, "C").End(xlUp).Row + 1, "C").Value = C
 End If
 End If
 Next C
 For Each C In ListB
 If C.Value <> "" Then
 Range("F2").Value = Range("F2").Value + 1
 If Application.CountIf(ListA, C) = 0 Then
 Cells(Cells(Rows.count, "D").End(xlUp).Row + 1, "D").Value = C
 End If
 End If
 Next C
 End Sub

This works great but there is a problem and it’s this. If there is a duplicate value in columns a so the data appears twice in column a but only once in columns b the macro does not identify this as a difference.
The data in both columns are alphanumerical in nature e.g.

Column A Column B Column C Column D
A103345 A103345 In A not in B In Column B not in A
A103389 A103389
A103389 A107799
A107799 A109999
A109999

Using the compare macro above I want it to work as above but to also identify that A103389 only appears in column B once but is in column A twice and list this as a difference in column in column C.
I would appreciate if you can just tell me what I need to do as simply as possible as I am pretty poor with Excel if I am honest.

Option Explicit
Sub Compare()
 Dim LstA As Range, LstB As Range, Cls As Range, Lst As Range
 Dim Lst1 As Range, Lst2 As Range, jJ As Byte

 [I1].Value = "Times":                          [k1].Value = "Times"
 [H1].Value = [A1].Value:                       [j1].Value = [b1].Value
 Range("d1").Value = "In A not in B":           Range("e1").Value = "In B not in A"
 Range("f1").Value = "Count of A":              Range("g1").Value = "Count of B"
 
 [d1].CurrentRegion.Offset(1).ClearContents
 Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[H1], Unique:=True
 Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[j1], Unique:=True
 
 Set LstA = Range([H1], [h65000].End(xlUp)):    Set Lst1 = Range([A1], [a65500].End(xlUp))
 Set LstB = Range([j1], [j65000].End(xlUp)):    Set Lst2 = Range([b1], [b65500].End(xlUp))
 
 For jJ = 1 To 2
    Set Lst = Choose(jJ, LstA, LstB)
    For Each Cls In Lst
        If Cls.Value <> "" Then
            With Cells(2, "E").Offset(, jJ)
                .Value = .Value + 1
            End With
            If Application.CountIf(Choose(jJ, Lst2, Lst1), Cls) > 0 Then _
                Cls.Offset(, 1).Value = Application.CountIf(Choose(jJ, Lst2, Lst1), Cls)
            
            If Application.CountIf(Choose(jJ, LstB, LstA), Cls) = 0 Then
                Cells(Cells(Rows.Count, 3 + jJ).End(xlUp).Row + 1, 3 + jJ).Value = Cls
            End If
        End If
    Next Cls
 Next jJ
 Exit Sub
End Sub

Hi. Sa DQ

I can see what the code above is trying to do but unfortunatley I can have approx 2000 individual rows of data to compare some of them will be genuinly duplicated others may even have 3 entries in one column but only 2 in the other and with that many its really difficlut to see where the differences are.

currently I am using a combination of macro's to find differences, the first cleans the macro of additional white spaces so they are not classed by Excel as differences.
The second macro is the one I posted which lists the differences but Excel doesnt understand duplicate entries properly.

I dont mind using more macros as long as it pulls out the information I need without me manually having to pull each difference out. Doing it in this way takes a long time or can do if there are 200 + differences in a list of 2000 rows.

Any further thoughts?
I have attached a copy of the kind of data I need to compare and hopefully you will see what I need to do.