Match Cell Content and Delete Cell Content If a Match is Found

Originally Posted by Leith Ross

Hello aviatecar,

This macro will do what you want. It is included in the attached workbook.

Sub CleanDescription()

    Dim c       As Long
    Dim Data    As Variant
    Dim r       As Long
    Dim Rng     As Range
    Dim RngEnd  As Range
    Dim Wks     As Worksheet
    
        Set Wks = Sheet1
        
        Set Rng = Wks.Range("A3")
        Set RngEnd = Wks.Cells(Rows.Count, "A").End(xlUp)
        Set Rng = IIf(RngEnd.Row > Rng.Row, Wks.Range(Rng, RngEnd), Rng)
        
        Data = Rng.Offset(0, 2).Resize(ColumnSize:=6).Value
        
            For r = 1 To UBound(Data)
                For c = 2 To 6
                    Data(r, 1) = Replace(Expression:=Data(r, 1), Find:=Data(r, c), Replace:="", Compare:=vbTextCompare)
                Next c
            Next r
        
        Rng.Offset(0, 2).Resize(ColumnSize:=6).Value = Data
        
End Sub

Thank you Leith,

The code works like a charm.

Chris