Compare two worksheets and List Differences

[Admin]

Hi,

Try

Sub kTest()
    
    Dim wksA        As Worksheet
    Dim wksB        As Worksheet
    Dim wksC        As Worksheet
    Dim i           As Long
    Dim n           As Long
    Dim c           As Long
    Dim dic         As Object
    Dim ka, k(), t
    
    Set wksA = ThisWorkbook.Worksheets("A")
    Set wksB = ThisWorkbook.Worksheets("B")
    Set wksC = ThisWorkbook.Worksheets("C")
    
    ka = wksA.UsedRange.Resize(, 8)
    ReDim k(1 To UBound(ka, 1) + 100, 1 To UBound(ka, 2))
    
    Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = 1
    
    For i = 2 To UBound(ka, 1)
        If Len(ka(i, 1)) Then
            If Not dic.exists(CStr(ka(i, 1))) Then
                n = n + 1
                For c = 1 To UBound(ka, 2)
                    k(n, c) = ka(i, c)
                Next
                dic.Add CStr(ka(i, 1)), Array(n, 1)
            Else
                t = dic.Item(CStr(ka(i, 1)))
                For c = 6 To UBound(ka, 2)
                    k(t(0), c) = k(t(0), c) + ka(i, c)
                Next
            End If
        End If
    Next
    Erase ka
    ka = wksB.UsedRange.Resize(, 8)
    For i = 2 To UBound(ka, 1)
        If Len(CStr(ka(i, 1))) Then
            If Not dic.exists(CStr(ka(i, 1))) Then
                n = n + 1
                For c = 1 To UBound(ka, 2)
                    k(n, c) = ka(i, c)
                Next
                dic.Add CStr(ka(i, 1)), Array(n, 2)
            Else
                t = dic.Item(CStr(ka(i, 1)))
                If t(1) = 1 Then
                    For c = 1 To UBound(ka, 2)
                        If c > 5 Then
                            k(t(0), c) = ka(i, c) - k(t(0), c)
                        ElseIf Len(k(t(0), c)) = 0 Then
                            k(t(0), c) = ka(i, c)
                        End If
                    Next
                Else
                    For c = 6 To UBound(ka, 2)
                        k(t(0), c) = k(t(0), c) + ka(i, c)
                    Next
                End If
            End If
        End If
    Next
    
    If n Then
        With wksC
            .UsedRange.Offset(1).ClearContents
            .Range("a2").Resize(n, UBound(k, 2)) = k
            .Range("a2").Resize(n, UBound(k, 2)).EntireColumn.AutoFit
        End With
    End If
    
End Sub

HTH