as an option
Sub ertert22()
'Dim tm!: tm = Timer
Dim x, i&, j&, ubx&
x = Range("D1:BN" & Cells(Rows.Count, 4).End(xlUp).Row).Value
ubx = UBound(x, 2)
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        For j = 1 To ubx
            If Len(x(i, j)) Then .Item(x(i, j)) = x(i, ubx)
        Next j
    Next i
    x = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
    For i = 1 To UBound(x)
        If Not .Exists(x(i, 1)) Then x(i, 1) = "" Else x(i, 1) = .Item(x(i, 1))
    Next i
End With
Range("B2").Resize(i - 1).Value = x
'MsgBox Timer - tm
End Sub