Could probably be more efficient, but seems to work for your example:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 12/26/2017 Dim strPattern1 As String, strPattern2 As String Dim oRngCompare As Range, oRng As Range strPattern1 = "SPEAKER ONE" strPattern2 = "SPEAKER TWO" Set oRngCompare = ActiveDocument.Paragraphs(2).Range oRngCompare.Start = ActiveDocument.Range.Start On Error GoTo lbl_Exit Do If InStr(oRngCompare, strPattern1) <> 1 Then Set oRng = oRngCompare.Paragraphs(1).Range oRng.Collapse wdCollapseStart oRng.MoveEnd wdCharacter, Len(strPattern1) oRng.HighlightColorIndex = wdRed End If If InStr(oRngCompare.Paragraphs(2), strPattern2) <> 1 Then Set oRng = oRngCompare.Paragraphs(2).Range oRng.Collapse wdCollapseStart oRng.MoveEnd wdCharacter, Len(strPattern2) oRng.HighlightColorIndex = wdRed End If oRngCompare.MoveStart wdParagraph, 2 oRngCompare.MoveEnd wdParagraph, 2 If oRngCompare.Paragraphs.Count < 2 Then Exit Sub Loop lbl_Exit: Exit Sub End Sub




Reply With Quote