Remove text from a cell that is contained in other multiple cells

[Rick73]

Hi all,

I am hoping that somebody can show me the easiest way to accomplish deleting the values in multiple cells from another cell. I thought it would be an easy SUBSTITUTE with "", but nothing I am writing works. It will obviously need a more elegant VBA solution.

From the table below I am using a common list of names, each name is separated with a carriage return (A1). For each row (2,3,4), I am trying to remove the names in the cells from column A, B, C from the list of names in A1 and display the remaining names in column E.
[TABLE="class: grid, width: 700"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]SURNAME Name 1
SURNAME Name 2
SURNAME Name 3
SURNAME Name 4
SURNAME Name 5
SURNAME Name 6
SURNAME Name 7
SURNAME Name 8[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"]RESULT[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]SURNAME Name 5[/TD]
[TD]SURNAME Name 2
SURNAME Name 3[/TD]
[TD]SURNAME Name 7
SURNAME Name 1[/TD]
[TD][/TD]
[TD]SURNAME Name 4
SURNAME Name 6
SURNAME Name 8[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]SURNAME Name 4
SURNAME Name 3[/TD]
[TD]SURNAME Name 8[/TD]
[TD]SURNAME Name 2[/TD]
[TD][/TD]
[TD]SURNAME Name 1
SURNAME Name 5
SURNAME Name 6
SURNAME Name 7[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]SURNAME Name 2
SURNAME Name 7
SURNAME Name 1[/TD]
[TD]SURNAME Name 8
SURNAME Name 3[/TD]
[TD]SURNAME Name 4
SURNAME Name 5[/TD]
[TD][/TD]
[TD]SURNAME Name 6[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Sounds simple but it is a little bit beyond my skills at the moment. I would greatly appreciate any help or code.

Regards
Rick73

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub ReduceSurnameList()
  Dim R As Long, X As Variant, NameList As String, CheckNames() As String
  For R = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    NameList = vbLf & Range("A1").Value & vbLf
    CheckNames = Split(Join(Application.Index(Cells(R, "A").Resize(, 3).Value, 1, 0), vbLf), vbLf)
    For X = 0 To UBound(CheckNames)
      NameList = Replace(NameList, vbLf & CheckNames(X) & vbLf, vbLf)
    Next
    For Each X In Split("121 13 5 3 3 2")
      NameList = Replace(NameList, vbLf & vbLf, vbLf)
    Next
    Cells(R, "E").Value = Mid(NameList, 2, Len(NameList) - 2)
  Next
End Sub[/td]
[/tr]
[/table]

 

[Rick73]

Thanks for your reply Rick

Sensational! Exactly how I would have coded it if I had the skill. Works perfectly.

Regards
Rick73