Hi -

Your problem has been solve now based on your feedback, and if you have read the rules, you know what's next;

Anyway, to give you some idea, I have commented the codes;
Sub test()
On Error Resume Next
For Each r In Range("b8:b" & Cells(Rows.Count, 2).End(xlUp).Row)'this line is where your values to find are located, for instance RED pertains to 'column B
    With Columns(1)'this pertains to Column A
        Set c = .Find(r.Value, , , 2)
            If Not c Is Nothing Then
                f = c.Address
                Do
                    c.Value = Replace(c.Value, r.Value, r.Offset(, 1).Value)
                Set c = .FindNext(c)
                Loop Until f = c.Address
            End If
    End With
Next
End Sub
Regards,
event