Hi Abjac,
I think this is a continuation of your previous topic. If so, then try
Sub FIndmatches()
Dim x, y, i&, j&
x = Sheets("Final Match").Cells(1).CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
.comparemode = 1
For i = 1 To UBound(x)
.Item(x(i, 4)) = i: x(i, 1) = Empty: x(i, 2) = Empty
Next i
y = Sheets("New Cars input").Cells(1).CurrentRegion.Value
For i = 2 To UBound(x, 1)
If .Exists(y(i, 3)) Then
j = .Item(y(i, 3))
x(j, 1) = y(i, 13): x(j, 2) = y(i, 13) - x(j, 9)
End If
Next
End With
x(1, 1) = "New Cars Input": x(1, 2) = "Difference"
With Sheets("Final Match").Columns(10).Resize(, 2)
.ClearContents: .Cells(1).Resize(UBound(x), 2).Value = x
End With
End Sub
Bookmarks