Looks like you changed sheet2 around some. Try this
Sub abc()
Const sh1 As String = "sheet1"
Const sh2 As String = "sheet2"
Const sh3 As String = "sheet3"
Dim aArr As Variant
Dim i As Long
Dim sEquipment As String
With Worksheets(sh1)
aArr = .Range("a2", .Cells(Rows.Count, "a").End(xlUp).Offset(, 2))
End With
With CreateObject("scripting.dictionary")
.CompareMode = 1
For i = 1 To UBound(aArr)
If Not .Exists(Trim$(aArr(i, 1)) & " " & Trim$(aArr(i, 2))) Then
.Item(Trim$(aArr(i, 1)) & " " & Trim$(aArr(i, 2))) = aArr(i, 3)
End If
Next
With Worksheets(sh2)
aArr = .Range("a2", .Cells(Rows.Count, "a").End(xlUp).Offset(, 4))
End With
For i = 1 To UBound(aArr)
If .Exists(Trim$(aArr(i, 3))) Then
sEquipment = .Item(Trim$(aArr(i, 3)))
With Worksheets(sh3)
With .Cells(Rows.Count, "b").End(xlUp).Offset(1, -1).Resize(, 6)
.Value = Array(aArr(i, 1), aArr(i, 2), aArr(i, 3), aArr(i, 4), aArr(i, 5), sEquipment)
.Borders.LineStyle = 1
End With
End With
Else
With Worksheets(sh3)
With .Cells(Rows.Count, "b").End(xlUp).Offset(1, -1).Resize(, 6)
.Value = Array(aArr(i, 1), aArr(i, 2), aArr(i, 3), aArr(i, 4), aArr(i, 5), Empty)
.Borders.LineStyle = 1
End With
End With
End If
Next
End With
End Sub
Bookmarks