Sub MatchBarCode()
Dim LR As Long, i As Long
Dim rFound As Variant
LR = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Range("A2:A" & LR).Cut Destination:=Range("IV2")
Range("IV2:IV" & LR).Sort Key1:=Range("IV2:IV" & LR), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For i = 2 To LR
x = Cells(i, "IV")
Set rFound = Columns("B").Find(What:=x, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
ALR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
If ALR < LR Then
ALR = LR + 1
End If
If rFound Is Nothing Then
Cells(ALR, "A") = x
Cells(i, "IV").Clear
GoTo 0
End If
rFound.Activate
ActiveCell.Offset(0, -1) = x
Cells(i, "IV").Clear
On Error GoTo 0
0
Next i
End Sub