Hi guys,
How do I find each word with two identical characters and color it
Please help me
Hi guys,
How do I find each word with two identical characters and color it
Please help me
Are the characters consective?
Cheers
Paul Edstein
[Fmr MS MVP - Word]
If the answer to Paul's question is yes:
otherwiseSub 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
Both may take awhile in a large document.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
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
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 SubSub 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
Cheers
Paul Edstein
[Fmr MS MVP - Word]
Paul,
Your mastery of find stings is rarely matched. Would you put:
.Text = "([! ])[! \1.,^09-^13]@\1"
... in the language of a layman please.
([! ]) = 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.
Cheers
Paul Edstein
[Fmr MS MVP - Word]
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.
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
Cheers
Paul Edstein
[Fmr MS MVP - Word]
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.