Compare two worksheets and List Differences

[excel_learner]

I have data in two sheets, one is from last year and other from this year. I want to combine these sheet remove the duplicates and take the difference (movement) in values from last year to this year. i.e (Current year - Last year).

I have attached the sheet containing the data and requirement.

Kindly assist.

[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