find and highlight

[asad]

Hi guys,
How do I find each word with two identical characters and color it
Please help me

[macropod]

Are the characters consective?

[gmaxey]

If the answer to Paul's question is yes:


Sub ScratchMacroI()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 10/22/2017
Dim oWord As Range
Dim oChr As Range
On Error GoTo Err_Handler
For Each oWord In ActiveDocument.Range.Words
For Each oChr In oWord.Characters
If oChr Like oChr.Next Then
oWord.HighlightColorIndex = wdBrightGreen
End If
Next
Next
lbl_Exit:
Exit Sub
Err_Handler:
Resume lbl_Exit
End Sub

otherwise


Sub ScratchMacroII()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 10/22/2017
Dim oWord As Range
Dim oChr As Range
Dim oCol As Collection
For Each oWord In ActiveDocument.Range.Words
Set oCol = New Collection
For Each oChr In oWord.Characters
On Error Resume Next
oCol.Add oChr, oChr
If Err.Number <> 0 Then
oWord.HighlightColorIndex = wdYellow
Exit For
End If
Next
Next
lbl_Exit:
Exit Sub
End Sub


Both may take awhile in a large document.

[macropod]

If the answer to Paul's question is yes:
I was thinking of a simple wildcard Find/Replace, where:
Find = (?)\1
Replace = ^&
and the replacement highlight option is chosen. Very fast...

[gmaxey]

Paul,

Certainly. For case yes, that is much simpler and faster. Thanks.


Sub ScratchMacroI()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "(?)\1"
With .Replacement
.Text = "^&"
.Highlight = True
End With
.Format = True
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
lbl_Exit:
Exit Sub
End Sub

[macropod]

For the others, one could use a different wildcard Find/Replace expression:
Find = ([! ])[! \1.,^09-^13]@\1
Replace = ^&
with the replacement highlight option chosen.

Do note these F/R expressions only highlight ranges within each word that qualify. To highlight the whole word, a macro would be required. For example:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([! .,^09-^13])\1"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
i = i + 1
.Start = .Words.First.Start
.End = .Words.First.End
.MoveEndWhile " ", -1
.HighlightColorIndex = wdBrightGreen
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([! ])[! \1.,^09-^13]@\1"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
i = i + 1
.Start = .Words.First.Start
.End = .Words.First.End
.MoveEndWhile " ", -1
.HighlightColorIndex = wdBrightGreen
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub

[gmaxey]

Paul,

Your mastery of find stings is rarely matched. Would you put:

.Text = "([! ])[! \1.,^09-^13]@\1"

... in the language of a layman please.

[macropod]

([! ]) = something that is not a space. The () says to store this.
[! \1.,^09-^13]@ = any sequence of characters that is not a space, period, comma, ASCII 10-13 (includes tab, manual line break, sections/page break or paragraph break), or the stored character.
\1 = the stored character.

[gmaxey]

Paul,

Thanks. So it seems that "something" must be found between two instances of the stored character. Your code highlights tortoise in the sentence below but not rabbit. Can the expression be modified to include (or nothing at all) between the first and second instance of the stored character so it would find both rabbit and tortoise without having to make two loops?


The rabbit and the tortoise ran a race.

[macropod]

That was the intent - I provided one solution for consecutive occurrences; another for non-consecutive occurrences. I don't think there's a wildcard expression that will do both. As for making two loops, the efficiency of second one could be improved by specifying that the find text is not to be highlighted (depending on the document, that could be applied to both passes, so only one version of the code is needed):

Sub Demo()
Application.ScreenUpdating = False
Dim x As Long, i As Long, ArrFnd()
ArrFnd = Array("([! .,^09-^13])\1", "([! ])[! \1.,^09-^13]@\1")
For x = 0 To UBound(ArrFnd)
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ArrFnd(x)
.Highlight = False
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
i = i + 1
.Start = .Words.First.Start
.End = .Words.First.End
.MoveEndWhile " ", -1
.HighlightColorIndex = wdBrightGreen
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Next
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub

[gmaxey]

Paul,

Yes, I understand what you did initially and suspected that there wasn't a single find expression to do both. Just asked to confirm. Thanks.