delete words from cellls

i have a blacklist of words i need to be deleted, 400 words

in another book, col A, I need to delete a word from a list in a cell where those words in are the cells. it is not a simple vlookup since col A format is lists of words sepeareted by commas

Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewIT / Software Engineering ConsultantCommented:
If you could upload a sample workbook that would be helpful.

finnstoneAuthor Commented:
here it is
Martin LissOlder than dirtCommented:
Sub RemoveBlacklisted()
Dim lngLastRow As Long
Dim lngRow As Long
Dim strWords() As String
Dim lngIndex As Long
Dim lngNextRow As Long
Dim wsBL As Worksheet
Dim rngFound As Range
Const DATA_COL = "A" ' Change as needed
Const FIRST_ROW = 1 ' Change as needed

Set wsBL = Sheets("blacklist")
lngLastRow = Range(DATA_COL & "1048576").End(xlUp).Row
lngNextRow = FIRST_ROW

For lngRow = FIRST_ROW To lngLastRow
    strWords = Split(Cells(lngRow, DATA_COL), ",")
    Cells(lngRow, DATA_COL).ClearContents
    For lngIndex = 0 To UBound(strWords)
        If strWords(lngIndex) = "" Then
            strWords(lngIndex) = " "
        End If
        Set rngFound = wsBL.Columns("A:A").Find(What:=Trim(strWords(lngIndex)), After:=ActiveCell)
        If rngFound Is Nothing Then
            If strWords(lngIndex) = " " Then
                strWords(lngIndex) = ""
            End If
            If lngIndex < UBound(strWords) Then
                Cells(lngRow, DATA_COL) = Cells(lngRow, DATA_COL) & Trim(strWords(lngIndex)) & ","
                Cells(lngRow, DATA_COL) = Cells(lngRow, DATA_COL) & Trim(strWords(lngIndex))
            End If
        End If
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
CompTIA Security+

Learn the essential functions of CompTIA Security+, which establishes the core knowledge required of any cybersecurity role and leads professionals into intermediate-level cybersecurity jobs.

Martin LissOlder than dirtCommented:
You’re welcome and I’m glad I was able to help.

And thank you for my 5 millionth point!

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange MVE 2015
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
finnstoneAuthor Commented:
thanks. wow lots of points
Martin LissOlder than dirtCommented:
There are 124 Experts with more points than I. The leader is Guy Hengel with 41 million!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.