Removing all single words from a list of words separated by commas

[linaeum66]

Is there a way using either a macro or find->replace to remove all single words from a list of words separated by commas?
For example, if I have a cell with the words “john smith,john myers,mike,john excel” I would like to remove the single word “mike” since it has no associated last name. I have a whole column of cells like this and would like to remove all the single words.

 

[Eric W]

Try this:

Open a copy of your book. Press Alt-F11 to open the VBA editor. From the menu, select Insert > Module, and paste this code:

Sub RemoveSingles()
Dim lr As Long, MyList As Variant, i As Long, Names As Variant, j As Long

    lr = Cells(Rows.Count, "A").End(xlUp).Row
    MyList = Range("A1:A" & lr).Value
    For i = 1 To UBound(MyList)
        Names = Split(MyList(i, 1), ",")
        For j = 0 To UBound(Names)
            If InStr(Trim(Names(j)), " ") = 0 Then Names(j) = "|"
        Next j
        MyList(i, 1) = Replace(Replace(Join(Names, ","), "|,", ""), "|", "")
    Next i
    Range("A1:A" & lr).Value = MyList
        
End Sub

Change the column designation in red to the column your data is in. If you have a header, change the 1 to a 2.

Now press Alt-Q to exit the editor. Press Alt-F8 to open the macro selector, choose RemoveSingles and press Run.

Let us know how that works.

 

[linaeum66]

Works perfectly! thanks so much for the incredibly quick reply.

Try this:

Open a copy of your book. Press Alt-F11 to open the VBA editor. From the menu, select Insert > Module, and paste this code:

Sub RemoveSingles()
Dim lr As Long, MyList As Variant, i As Long, Names As Variant, j As Long

    lr = Cells(Rows.Count, "A").End(xlUp).Row
    MyList = Range("A1:A" & lr).Value
    For i = 1 To UBound(MyList)
        Names = Split(MyList(i, 1), ",")
        For j = 0 To UBound(Names)
            If InStr(Trim(Names(j)), " ") = 0 Then Names(j) = "|"
        Next j
        MyList(i, 1) = Replace(Replace(Join(Names, ","), "|,", ""), "|", "")
    Next i
    Range("A1:A" & lr).Value = MyList
        
End Sub

Change the column designation in red to the column your data is in. If you have a header, change the 1 to a 2.

Now press Alt-Q to exit the editor. Press Alt-F8 to open the macro selector, choose RemoveSingles and press Run.

Let us know how that works.

 

[Rick Rothstein]

Works perfectly!

In case you are interested, here is another macro (more compact and with no loops) for you to consider...

[table="width: 500"]
[tr]
	[td]Sub RemoveSingles()
  Dim WordList As Variant
  WordList = Split(Join(Filter(Split(Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))), ", ,"), ","), " "), ","), ", ,")
  Range("A1").Resize(UBound(WordList) + 1) = Application.Transpose(WordList)
End Sub[/td]
[/tr]
[/table]

 

[Eric W]

Glad we could help.

 

[Rick Rothstein]

Glad we could help.

The OP was thanking only you... I don't think he has come back (or, maybe, is even coming back) in order to have seen what I posted.

 

[Eric W]

Very possible. Nevertheless, if anyone else responds to a question, I like to acknowledge their contribution. Even if the OP doesn't see your message, this post will likely be seen in the future by other searchers, and I think it's valuable to see more than one way of doing things. I know I've learned a lot from other posts (especially yours!).