Word VBA - Find some word within a coded text, change font color and insert a comment

[AlexandarR]

Hi!
I have to find some (whole words - Ex: "I", "we", "us", "our") within a paragraph, surrounded by a coding <ABS>...</ABS>. Irrespective of the order, all occurrences of each word should be highlighted and a comment should be inserted ("CE: The use of personal pronouns (I, we, us, our) is not permitted in the abstract.").
The following coding needs to be changed.



Sub z_Abstract()
Dim vFindText As Variant
Dim oRng As Range
Dim oSearch As Range
Dim oFound As Range
Dim i As Long
Dim sAsk As String
Options.DefaultHighlightColorIndex = wdTurquoise
vFindText = Array("I", "we", "us", "our")
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="\<ABS\>*\<\/ABS\>", MatchWildcards:=True)
Set oSearch = oRng
For i = 0 To UBound(vFindText)
Set oFound = oSearch
With oFound.Find
Selection.Font.Color = wdColorPink
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
Do While .Execute(FindText:=vFindText(i), _
MatchWholeWord:=True, _
MatchWildcards:=True, _
Forward:=True, _
Wrap:=wdFindStop) = True
'oFound.Text = sReplaceText
oFound.HighlightColorIndex = wdTurquoise
oFound.Font.Color = wdColorPink
oFound.Comments.Add oFound, "CE: The use of personal pronouns (I, we, us, our) is not permitted in the abstract."
oFound.Collapse wdCollapseEnd
If oFound.End >= oSearch.End Then Exit Do
Loop
End With
Next i
Loop
End With
lbl_Exit:
Exit Sub
End Sub


That code finds in order of the array only. i.e. In the following text, the macro finds the text, only in the same order in the array, and it finds a text once only.

<ABS>The use of personal pronouns (our, us, I, we) is not permitted in the abstract. The use of personal pronouns (I, we, us, our) is not permitted in the abstract. </ABS>

I need to find all occurrences of a [whole] word irrespective of the order, within the coded text.

Please help.

Thanks!
Alex

[gmaxey]

Sub z_Abstract()
Dim strFind() As String
Dim oRng As Range
Dim oRngTag As Range
Dim lngIndex As Long
strFind = Split("I|we|us|our", "|")
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="\<ABS\>*\<\/ABS\>", MatchWildcards:=True)

For lngIndex = 0 To UBound(strFind)
Set oRngTag = oRng.Duplicate
With oRngTag.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
Do While .Execute(FindText:=strFind(lngIndex), MatchWholeWord:=True, MatchWildcards:=True, Forward:=True, Wrap:=wdFindStop) = True
With oRngTag
.HighlightColorIndex = wdTurquoise
.Font.Color = wdColorPink
.Comments.Add oRngTag, "CE: The use of personal pronouns (I, we, us, our) is not permitted in the abstract."
.Collapse wdCollapseEnd
If .End >= oRngTag.End Then Exit Do
End With
Loop
End With
Next lngIndex
oRng.Collapse wdCollapseEnd
Loop
End With
lbl_Exit:
Exit Sub
End Sub

[AlexandarR]

Hi!:hi:
First of all, I wish to thank you very much to come forward to solve this problem.

I have tested this coding, the result is shown below:

<ABS> This is for testing: I[a1] n, awe[a2] some, hous[a3] e, hour[a4]. The use of personal pronouns (I, we, us, our) is not permitted in the abstract. The use of personal pronouns (us, I, our, we) is not permitted in the abstract.</ABS>

Comments are inserted for each occurrences correctly.

My requirements:
1. Only whole words to be find. Now, it finds part of words also.
2. All occurrences of the words should be highlighted. Now, only one occurrence highlighted.

Kindly help!:help

Thanks
Alex

[gmaxey]

Sub z_Abstract()Dim strFind() As StringDim oRng As RangeDim oRngTag As RangeDim lngIndex As Long strFind = Split("I|we|us|our", "|") Set oRng = ActiveDocument.Range With oRng.Find Do While .Execute(FindText:="\*\", MatchWildcards:=True) For lngIndex = 0 To UBound(strFind) Set oRngTag = oRng.Duplicate With oRngTag.Find .ClearFormatting .Replacement.ClearFormatting .MatchWholeWord = True Do While .Execute(FindText:=strFind(lngIndex), Forward:=True, Wrap:=wdFindStop) = True With oRngTag .HighlightColorIndex = wdTurquoise .Font.Color = wdColorPink .Comments.Add oRngTag, "CE: The use of personal pronouns (I, we, us, our) is not permitted in the abstract." .Collapse wdCollapseEnd If .End >= oRng.End Then Exit Do End With Loop End With Next lngIndex oRng.Collapse wdCollapseEnd Loop End Withlbl_Exit: Exit SubEnd Sub

[AlexandarR]

Hi!

Nothing happen when I run this code...!!!:dunno

Just test that code on this text:

<ABS>This is for testing: In, house, hour, awesome. The use of personal pronouns (our, us, I, we) is not permitted in the abstract. The use of personal pronouns (I, we, us, our) is not permitted in the abstract. </ABS>

I'm waiting...!

Thanks in advance!

Alex

[gmaxey]

Sub z_Abstract()
Dim strFind() As String
Dim oRng As Range
Dim oRngTag As Range
Dim lngIndex As Long
strFind = Split("I|we|us|our", "|")
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="\<ABS\>*\<\/ABS\>", MatchWildcards:=True)
For lngIndex = 0 To UBound(strFind)
Set oRngTag = oRng.Duplicate
With oRngTag.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
Do While .Execute(FindText:=strFind(lngIndex), Forward:=True, Wrap:=wdFindStop) = True
With oRngTag
.HighlightColorIndex = wdTurquoise
.Font.Color = wdColorPink
.Comments.Add oRngTag, "CE: The use of personal pronouns (I, we, us, our) is not permitted in the abstract."
.Collapse wdCollapseEnd
If .End >= oRng.End Then Exit Do
End With
Loop
End With
Next lngIndex
oRng.Collapse wdCollapseEnd
Loop
End With
lbl_Exit:
Exit Sub
End Sub

[AlexandarR]

Hi!:hi:

Thank you very much!

1. Only whole words to be find. - Fixed.
2. All occurrences of the words should be highlighted. - Fixed.

But, it finds outside the coding <ABS>...</ABS> (I, we, us, our - each one time).

If this is fixed, then it will be 100% perfect. Can you please check...

Thanks again!!

Alex

[gmaxey]

Sub z_Abstract()
Dim strFind() As String
Dim oRng As Range, oRngTag As Range, oRngLimit As Range
Dim lngIndex As Long
strFind = Split("I|we|us|our", "|")
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="\<ABS\>*\<\/ABS\>", MatchWildcards:=True)
For lngIndex = 0 To UBound(strFind)
Set oRngTag = oRng.Duplicate
Set oRngLimit = oRng.Duplicate
With oRngTag.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
Do While .Execute(FindText:=strFind(lngIndex), Forward:=True, Wrap:=wdFindStop) = True
With oRngTag
If Not oRngTag.InRange(oRngLimit) Then Exit Do
.HighlightColorIndex = wdTurquoise
.Font.Color = wdColorPink
.Comments.Add oRngTag, "CE: The use of personal pronouns (I, we, us, our) is not permitted in the abstract."
.Collapse wdCollapseEnd
End With
Loop
End With
Next lngIndex
oRng.Collapse wdCollapseEnd
Loop
End With
lbl_Exit:
Exit Sub
End Sub

[AlexandarR]

Hi! :hi:

It is 100% perfect! :clap: It works excellent!!

Thank you very much!!!

Regards
Alex

[AlexandarR]

Hi!

I have to find some whole words (Ex: "Telephone", "Fax") within a paragraph, surrounded by a coding <ADDRESS>...</ADDRESS>.

If the word found, "Telephone/Fax no. found" comment has to be inserted.

If not found "No Telephone/Fax no. found" comment has to be inserted.



Sub a_Address()
Dim strFind() As String
Dim oRng As Range, oRngTag As Range, oRngLimit As Range
Dim lngIndex As Long
strFind = Split("Telephone|Tel.|Fax|fax", "|")
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="\<ADDRESS\>*\<\/ADDRESS\>", MatchWildcards:=True)
For lngIndex = 0 To UBound(strFind)
Set oRngTag = oRng.Duplicate
Set oRngLimit = oRng.Duplicate
With oRngTag.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
Do While .Execute(FindText:=strFind(lngIndex), Forward:=True, Wrap:=wdFindStop) = True
With oRngTag
If Not oRngTag.InRange(oRngLimit) Then Exit Do
.HighlightColorIndex = wdTurquoise
.Font.Color = wdColorPink
.Comments.Add oRngTag, "Telephone/Fax no. found"
.Collapse wdCollapseEnd
End With
Loop
End With
Next lngIndex
oRng.Collapse wdCollapseEnd
Loop
End With
lbl_Exit:
Exit Sub
End Sub

If the keywords found, the above coding perfectly inserts comment and highlight.
Please modify the coding for "Not Found" case.
Thanks in advance!!!
Regards
Alex

[gmaxey]

You should start a new thread when you have a new question. You should also learn to catch your own fish:


Sub a_Address()
Dim strFind() As String
Dim oRng As Range, oRngTag As Range, oRngLimit As Range, lngIndex As Long
Dim bFound As Boolean

strFind = Split("Telephone|Tel.|Fax|fax", "|")
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="\<ADDRESS\>*\<\/ADDRESS\>", MatchWildcards:=True)
bFound = False
For lngIndex = 0 To UBound(strFind)
Set oRngTag = oRng.Duplicate
Set oRngLimit = oRng.Duplicate
With oRngTag.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.MatchCase = True
Do While .Execute(FindText:=strFind(lngIndex), Forward:=True, Wrap:=wdFindStop) = True
bFound = True
With oRngTag
If Not oRngTag.InRange(oRngLimit) Then Exit Do
.HighlightColorIndex = wdTurquoise
.Font.Color = wdColorPink
.Comments.Add oRngTag, "Telephone/Fax no. found"
.Collapse wdCollapseEnd
End With
Loop
End With
Next lngIndex
If Not bFound Then oRng.Comments.Add oRngTag, "Telephone/Fax no. was not found"
oRng.Collapse wdCollapseEnd
Loop
End With
lbl_Exit:
Exit Sub
End Sub

[AlexandarR]

Thanks a lot!!!

I have started learning word VBA...

Regards
Alex