Macro to Replace/Delete Text Using "Watchword" List?

[Guest]

We have a vendor who sends us spreadsheets listing photo specs. There can be
several hundred specs in a sheet. Each one of these is accompanied by a long
list of descriptors: Key terms we use to catalog the photos in our database.
All of a photo's descriptors appear in one cell, spearated by a vertical rule
with spaces. An example looks like this:

| Pensive | Pink | Young | adults | Sundress | woman | lady | musing |
wondering | thoughtful | introspective | introspection | thought | pondering
| pensiveness | contemplative | contemplating | one | person | individual |
human | alone |


There are many terms used by the vendor, however, that for various reasons
aren't standard for us. Before specs can be fed into the database, these
"bogey descriptors" have to be deleted. (Don't ask me WHY they have to be
deleted: My bosses simply assure me that they do.) I have a long list of
"watchwords" that I check each spec for. If a term in that list appears, i
delete its occurence in the string of descriptors. In the example,
"pensiveness" and "contemplative" are on the list of banned terms, so I take
them out, leaving

| Pensive | Pink | Young | adults | Sundress | woman | lady | musing |
wondering | thoughtful | introspective | introspection | thought | pondering
| contemplating | one | person | individual | human | alone |

The list of "banned terms" is now some 200 items long. Up to now, I've been
doing a find and replace for each one, but obviously even that takes a long
time with so many terms to enter in.

The question is: Is it possible to write a macro that A) would automatically
look for and delete all of the terms on my list (which is always evolving),
and B) could be carried out in whatever range is selected, as opposed to a
fixed range? ("B" is important, because sometime the spreadsheets from the
vendor supplying the specs varies slightly in format.) Unfortunately, it's a
requirement that key terms be separated as shown, with a space, vertical
rule, and a space. (My list of "banned terms," however, is just a listing in
the first column of a workbook, each term in a separate cell.) All terms in
the modified spec record must still occupy one cell. Sigh.

I know all of this is kind of "Brazil"-like, and I don't like thinking about
the futility of it all--I would just really, really, really appreciate any
suggestions to help make this depressing task go away. Please help!

 

[Sandy Mann]

With the Watchwords in Column A and nothing else, try selecting the range
that you want to delete the words from and running a Macro something like
this:

Sub WatchWords()
Dim LastWord As Long
Dim x As Long

With Selection
LastWord = Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To LastWord
.Replace What:=Cells(x, 1), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Next x
End With

End Sub

--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk

 

[Sandy Mann]

If you have a very large amount of data then the Macro will run quicker if
you turn off screen updating:

Sub WatchWords()
Dim LastWord As Long
Dim x As Long

Application.ScreenUpdating = False

With Selection
LastWord = Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To LastWord
.Replace What:=Cells(x, 1), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Next x
End With

Application.ScreenUpdating = True
End Sub

--
HTH

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk

 

[Guest]

I see that Sandy Mann has given you a solution on the next page forward.
Heres mine:

Sub DelWords()
Dim nr As Integer, i As Integer, j As Integer
Dim BadWords, str As String, c, Word2Del
Worksheets(3).Select
Range("A2").Select
nr = ActiveCell.CurrentRegion.Rows.Count
'gather good words into array
For i = 1 To nr
If i = nr Then
str = str & Cells(i, 1)
Else: str = str & Cells(i, 1) & ","
End If
Next i
BadWords = Split(str, ",")
Worksheets(2).Activate

For Each c In Selection
c.Select
' get rid of the pipes "|" and spaces
c = Application.WorksheetFunction.Substitute(c, "|", "")
c = Application.WorksheetFunction.Trim(c)
str2 = c
'Create array of words in sheet2
words = Split(str2, " ") 'two spaces in your data
' loop through cell sheet2
For w = LBound(words) To UBound(words)
' loop through badwords
For j = LBound(BadWords) To UBound(BadWords)
If words(w) = BadWords(j) Then
str2 = Application.WorksheetFunction.Substitute(str2,
BadWords(j), "")

End If
Next j
Next w
' Replace the pipes
x = Application.WorksheetFunction.Substitute(str2, " ", " ")
x = Trim(x)
x = Application.WorksheetFunction.Substitute(x, " ", " | ")
ActiveCell = x
Next c
End Sub

It assumes that your list of bad words are on sheet3 and your data is on
sheet2. (Change to suit). Select the data and run the code. Try it on a
workbook copy first

Regards
Peter

 

[Guest]

I should have included lines to turn Off/On screen updating, ignore the last
post and use:

Sub WatchWords()
Dim LastWord As Long
Dim x As Long

Application.ScreenUpdating = False

With Selection
LastWord = Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To LastWord
.Replace What:=Cells(x, 1), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Next x
End With

Application.ScreenUpdating = True
End Sub

============
The pipes "|" can be used as delimiters so that each word separated by a
pipe goes into a different database field. Ask your boss can you see the the
database lists and it should be clearer. If bad words are included it may
cause the database to fail, so what you are doing is important.

I think that my macro preserves the formating and removes extra pipes post
back if this is not the case.

Best of luck
Peter

 

[Guest]

Sorry about the delay in replying, but shortly after I sent this yesterday, I
went home to drown my despair in drink.

Both this and the other replies to my post look fabulous! I literally just
sat down this morning, so I haven't had time to deploy any of the solutions,
but how wonderful that there ARE answers! I really was desperate. Thank you
for getting my day off to a great start--I needed it.

I'll work with all of these throughout the day and reply back with details
on my gratitude. Unfortunately, I'll be in and out of meetings most of the
day, so some of this will have to wait until Saturday. Thank you so much
everyone! You've helped a truly overwhelmed troglodyle!

 

[Guest]

Got it. Thanks again, Billy!

 

[Guest]

Thanks, Sandy! See my first reply to Billy (or is it Peter? I'm not sure),
above. I am truly, truly, thankful for the help both of you have offered. As
I get a chance to work with this throughout the day and weekend, I'll reply
back to let you know how it goes. Thanks again!

 

[Guest]

Your welcome

I know the felling about needing a drink!

Best of luck

Peter

The late Billy Liddel played football for Scotland and Liverpool FC, my
brother played tennis against him when he retired.

 

[Sandy Mann]

The late Billy Liddel played football for Scotland and Liverpool FC, my

brother played tennis against him when he retired.

Didn't he spell his name with two L's?

http://www.liverpoolfc.tv/team/past_players/players/liddell/

--
Regards,

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk

 

[Guest]

Well spotted Sandy!

Didn't he spell his name with two L's?

http://www.liverpoolfc.tv/team/past_players/players/liddell/

--
Regards,

Sandy
In Perth, the ancient capital of Scotland
and the crowning place of kings

(e-mail address removed)
Replace @mailinator.com with @tiscali.co.uk