Hello all,

I have this recurrent task where I need to search trough a document for a bunch of keywords and highlight them somehouw, preferred with a different color.
Of course I can do an Cntl-F enter text and search for it but the keywords are too much.

Let me explain it on a easy way,

Excel:
A list of cells (in one column) with keywords, say: green dog, big cat, small bird, green tree etc.

Word:
A portion of text where the spoken keywords may appear randomly.

Desired:
If a keyword (actually sentence because it can have multiple words) is found in the Word text it should be highlighted (preferrable a different color for keyword). Would be superduper if a cell in Excel near to the keyword would display if the keyword was found or not.

Just wanted to know if some of you experts saw somewhere a solution for this and can tell me where to fing it.
Any help would be grateful!

Cheers,

Fred.

Hi Ronald,

Here's an example:

Sub Macro1()
Dim keywords As String, c As Range, n As Integer
keywords = "green" ' adapt
With Worksheets(1).Range("a1:a500")
Set c = .Find(keywords, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address

Do
n = Application.Find("green", c)
With c.Characters(Start:=n, Length:=Len(keywords))
.Font.Color = RGB(255, 0, 0)
End With

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress

End If
End With
End Sub

isabelle

Le 2016-10-19 Ã* 15:51, Ronald a écrit :
Hello all,

I have this recurrent task where I need to search trough a document for a
bunch of keywords and highlight them somehouw, preferred with a different
color. Of course I can do an Cntl-F enter text and search for it but the
keywords are too much.

Let me explain it on a easy way,

Excel: A list of cells (in one column) with keywords, say: green dog, big
cat, small bird, green tree etc.

Word: A portion of text where the spoken keywords may appear randomly.

Desired: If a keyword (actually sentence because it can have multiple words)
is found in the Word text it should be highlighted (preferrable a different
color for keyword). Would be superduper if a cell in Excel near to the
keyword would display if the keyword was found or not.

Just wanted to know if some of you experts saw somewhere a solution for this
and can tell me where to fing it. Any help would be grateful!

Cheers,

Fred.

oops sory,
replace
n = Application.Find("green", c)
by
n = Application.Find(keywords, c)

isabelle

Le 2016-10-19 Ã* 19:24, isabelle a écrit :
Hi Ronald,

Here's an example:

Sub Macro1()
Dim keywords As String, c As Range, n As Integer
keywords = "green" ' adapt
With Worksheets(1).Range("a1:a500")
Set c = .Find(keywords, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address

Do
n = Application.Find("green", c)
With c.Characters(Start:=n, Length:=Len(keywords))
.Font.Color = RGB(255, 0, 0)
End With

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress

End If
End With
End Sub

isabelle

Le 2016-10-19 Ã* 15:51, Ronald a écrit :
Hello all,

I have this recurrent task where I need to search trough a document for a
bunch of keywords and highlight them somehouw, preferred with a different
color. Of course I can do an Cntl-F enter text and search for it but the
keywords are too much.

Let me explain it on a easy way,

Excel: A list of cells (in one column) with keywords, say: green dog, big
cat, small bird, green tree etc.

Word: A portion of text where the spoken keywords may appear randomly.

Desired: If a keyword (actually sentence because it can have multiple words)
is found in the Word text it should be highlighted (preferrable a different
color for keyword). Would be superduper if a cell in Excel near to the
keyword would display if the keyword was found or not.

Just wanted to know if some of you experts saw somewhere a solution for this
and can tell me where to fing it. Any help would be grateful!

Cheers,

Fred.

....it would be better to specify "a part of the cell"
replace
Set c = .Find(keywords, LookIn:=xlValues)
by
Set c = .Find(keywords, LookIn:=xlValues, LookAt:=xlPart)

isabelle

Le 2016-10-19 Ã* 19:32, isabelle a écrit :
oops sory,
replace
n = Application.Find("green", c)
by
n = Application.Find(keywords, c)

isabelle

Le 2016-10-19 Ã* 19:24, isabelle a écrit :
Hi Ronald,

Here's an example:

Sub Macro1()
Dim keywords As String, c As Range, n As Integer
keywords = "green" ' adapt
With Worksheets(1).Range("a1:a500")
Set c = .Find(keywords, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address

Do
n = Application.Find("green", c)
With c.Characters(Start:=n, Length:=Len(keywords))
.Font.Color = RGB(255, 0, 0)
End With

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress

End If
End With
End Sub

isabelle

Le 2016-10-19 Ã* 15:51, Ronald a écrit :
Hello all,

I have this recurrent task where I need to search trough a document for a
bunch of keywords and highlight them somehouw, preferred with a different
color. Of course I can do an Cntl-F enter text and search for it but the
keywords are too much.

Let me explain it on a easy way,

Excel: A list of cells (in one column) with keywords, say: green dog, big
cat, small bird, green tree etc.

Word: A portion of text where the spoken keywords may appear randomly.

Desired: If a keyword (actually sentence because it can have multiple words)
is found in the Word text it should be highlighted (preferrable a different
color for keyword). Would be superduper if a cell in Excel near to the
keyword would display if the keyword was found or not.

Just wanted to know if some of you experts saw somewhere a solution for this
and can tell me where to fing it. Any help would be grateful!

Cheers,

Fred.

Hi Ronald,

Am Wed, 19 Oct 2016 12:51:32 -0700 (PDT) schrieb Ronald:

Excel:
A list of cells (in one column) with keywords, say: green dog, big cat, small bird, green tree etc.

Word:
A portion of text where the spoken keywords may appear randomly.

Desired:
If a keyword (actually sentence because it can have multiple words) is found in the Word text it should be highlighted (preferrable a different color for keyword). Would be superduper if a cell in Excel near to the keyword would display if the keyword was found or not.

open your Word doc. In Excel your keywords are in column A. Then try:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varText As Variant
Dim myDoc As Object

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varText = .Range("A1:A" & LRow)
End With

Set myDoc = GetObject(, "Word.Application")
n = 4
For i = LBound(varText) To UBound(varText)
n = n + 1
With ActiveDocument.Content.Find
Options.DefaultHighlightColorIndex = n
With .Replacement
.Highlight = True
End With
.Execute FindText:=varText(i, 1), ReplaceWith:="", Format:=True,
Replace:=wdReplaceAll
End With
Next
End Sub

Set a reference to Microsoft Word xx.0 Object Library.


Regards
Claus B.
--
Windows10
Office 2016

@Claus,

Many thanks for your help!
It looks promising but an error still appear :-(

Run-time error '424':
Object required

This with the following line highlighted: "With ActiveDocument.Content.Find"

I had the Word document (word 2010) open with text in it. Tried with a new and saved document.

Any clue?


The code I've used is:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varText As Variant
Dim myDoc As Object

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varText = .Range("A1:A" & LRow)
End With

Set myDoc = GetObject(, "Word.Application")
n = 4
For i = LBound(varText) To UBound(varText)
n = n + 1
With ActiveDocument.Content.Find
Options.DefaultHighlightColorIndex = n
With .Replacement
.Highlight = True
End With
.Execute FindText:=varText(i, 1), ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
End With
Next
End Sub

Thanks Isabelle!

I've tried it but without success.
I think it's not really jumping to Word to find the text isn't it?

I've used the following code:

Sub MacroIsab()
Dim keywords As String, c As Range, n As Integer
keywords = "verliep" ' adapt
With Worksheets(1).Range("a1:a500")
Set c = .Find(keywords, LookIn:=xlValues, LookAt:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
n = Application.Find(keywords, c)
With c.Characters(Start:=n, Length:=Len(keywords))
.Font.Color = RGB(255, 0, 0)
End With
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress

End If
End With
End Sub

Hi Ronald,

Am Thu, 20 Oct 2016 02:39:16 -0700 (PDT) schrieb Ronald:

It looks promising but an error still appear :-(

Run-time error '424':
Object required

have you set a reference to Microsoft Word Library in VB editor?
Here it works without problems.

Try:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varText As Variant
Dim myDoc As Object, myText As Object

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varText = .Range("A1:A" & LRow)
End With

Set myDoc = GetObject(, "Word.Application")
With myDoc
.Activate
.Visible = True
Set myText = .ActiveDocument.Content
End With
n = 4
For i = LBound(varText) To UBound(varText)
n = n + 1
With myText.Find
Options.DefaultHighlightColorIndex = n
With .Replacement
.Highlight = True
End With
.Execute FindText:=varText(i, 1), ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
End With
Next
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Smoking!
That did the trick, wasn't aware of the existence of it. Thanks.
It works like a charm, really.

IF possible, and just as nice to have:
-Is it possible to mark on the Excel sheet (lets say column D) if the sentence was found?
-My list of sentences was 42 items long, the highlight color ran out of options and went grey for the last ones.

Like I said, IF possible I would be VERY happy with point 1 and can live without #2.

Again, thanks Claus!

Hi Ronald,

Am Thu, 20 Oct 2016 04:26:47 -0700 (PDT) schrieb Ronald:

IF possible, and just as nice to have:
-Is it possible to mark on the Excel sheet (lets say column D) if the sentence was found?
-My list of sentences was 42 items long, the highlight color ran out of options and went grey for the last ones.

try:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varText As Variant
Dim myDoc As Object, myText As Object

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varText = .Range("A1:A" & LRow)
End With

Set myDoc = GetObject(, "Word.Application")
With myDoc
.Activate
.Visible = True
Set myText = .ActiveDocument.Content
End With
n = 4
For i = LBound(varText) To UBound(varText)
With myText.Find
Options.DefaultHighlightColorIndex = n
With .Replacement
.Highlight = True
End With
.Execute FindText:=varText(i, 1), ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
If .Found = True Then
ActiveSheet.Range("D" & i) = "Match found"
n = n + 1
End If
End With
Next
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Claus,

You should know that I really f*****g appreciate your help!
It will save time and easy up my work.

Thank you very much!

Hi Ronald,

Am Thu, 20 Oct 2016 04:57:24 -0700 (PDT) schrieb Ronald:

It will save time and easy up my work.

you are welcome. Always glad to help.


Regards
Claus B.
--
Windows10
Office 2016

One last thing Claus....

Once the script is ready it is located on the Word document.
Is it possible to pop-up a message over there that says it's ready?
A msgbox is not a problem but it only works in Excel. If not possible then just the code to jump back to Excel, then I put the message box.

Again, appreciated your help. Thanks!

Ronald.

Hi Ronald,

Am Thu, 20 Oct 2016 11:17:16 -0700 (PDT) schrieb Ronald:

Once the script is ready it is located on the Word document.
Is it possible to pop-up a message over there that says it's ready?
A msgbox is not a problem but it only works in Excel. If not possible then just the code to jump back to Excel, then I put the message box.

try it this way:

Sub Test()
Dim LRow As Long, i As Long, n As Long
Dim varText As Variant
Dim myDoc As Object, myText As Object

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varText = .Range("A1:A" & LRow)
End With

Set myDoc = GetObject(, "Word.Application")
Set myText = myDoc.ActiveDocument.Content

n = 4
For i = LBound(varText) To UBound(varText)
With myText.Find
Options.DefaultHighlightColorIndex = n
With .Replacement
.Highlight = True
End With
.Execute FindText:=varText(i, 1), ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
If .Found = True Then
ActiveSheet.Range("D" & i) = "Match found"
n = n + 1
End If
End With
Next
MsgBox "Search done"
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Perfect as usual, many thanks and have a good weekend!

Just to clarify in case someone else want to use this piece of macro also:
if you use n = 8 then command line
Options.DefaultHighlightColorIndex wil set the highlighted text to WHITE :-(

Small issue but can be annoying if you are searching for a specific piece of text.

Ronald.

Hello Claus,

As usual once a tool works good you wondering if a certain step can be integrated....

Is it possible to add a comment on the found text in Word and put whats on column B from the same excel row?

So having the code so far, in the example below "Search me" will be find in Word, "CommSearchme" will be add as comment to sentence "Search me" in Word and column D will be updated because the sentence was found.

Col A Col B Col D
Search me CommSearchme Match Found.

Many thanks in advance for any help you could provide!

Ronald.

Hi Ronald,

Am Mon, 24 Oct 2016 07:30:59 -0700 (PDT) schrieb Ronald:

Is it possible to add a comment on the found text in Word and put whats on column B from the same excel row?

So having the code so far, in the example below "Search me" will be find in Word, "CommSearchme" will be add as comment to sentence "Search me" in Word and column D will be updated because the sentence was found.

Col A Col B Col D
Search me CommSearchme Match Found.

I am not a word expert. You better ask in a word newsgroup.


Regards
Claus B.
--
Windows10
Office 2016