Questions

looping macro to find & highlight text strings pulled from array/collectio

+
0 Votes
Locked

looping macro to find & highlight text strings pulled from array/collectio

pateoauchter
I?m a newbie to VBA, so apologies in advance.

With a macro in MS Word, I want to find and highlight all instances of a given text string, plus loop in order to do this for all text strings in an array/collection, {txt_string1,txt_string2,txt_string3,...}. The array/collection will have 65-80 text strings.

As a starting point, I have recorded a macro that ran once successfully for the text string ?cannot?, but then it would not run again; don?t know why. Here?s the code for that macro.

Sub highlight_txt_string_cannot()
'
' highlight_txt_string_cannot Macro
' Macro recorded 9/14/2007 by Thomas S. Auchterlonie
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "cannot"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Range.HighlightColorIndex = wdYellow
End Sub

I think that I need to loop through the array/collection using a For Each ? Next construct, but I don?t know how to set that up. Nor do I know how to set up the array/collection.

Thanks in advance.
  • +
    0 Votes
    pateoauchter

    With the help of a friend who knows Visual Basic, and some digging through the internet (thanks go to http://wordtips.vitalnews.com/Pages/T1870_Highlight_Words_from_a_Word_List.html), was able to get a quasi-highlight-macro to run in MSWord.

    The macro still has some flaws. The "Find All Word Forms" option cannot handle a non-alphabet character, so it won't search the phrases "can not", "has to", "have to" and "such as". Also, for some reason, the "Find All Word Forms" option will not find any instance of a text string if that string happens also to appear in a heading (perhaps this is a formatting parameter that needs to be set to false).

    So, the macro no longer adds highlighting to words as that seemed to be one of the problems. Rather, the macro finds the desired words and changes their font to size 18.

    The macro code is printed below.

    Sub callout_txt_strings()
    Dim sCheckDoc As String
    Dim docRef As Document
    Dim docCurrent As Document
    Dim wrdRef As Object

    sCheckDoc = "c:\checklist.doc"
    Set docCurrent = Selection.Document
    Set docRef = Documents.Open(sCheckDoc)
    docCurrent.Activate

    With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    '.Replacement.Font.Bold = True
    .Replacement.Font.Size = 18
    .Replacement.Text = "^&"
    .Forward = True
    .Format = True
    .MatchWholeWord = False
    .MatchAllWordForms = True
    .MatchCase = False
    .MatchWildcards = False
    End With

    For Each wrdRef In docRef.Words
    If Asc(Left(wrdRef, 1)) > 32 Then
    With Selection.Find
    .Wrap = wdFindContinue
    .Text = wrdRef
    '.Replacement.Highlight = True
    .Execute Replace:=wdReplaceAll
    End With
    End If
    Next wrdRef

    docRef.Close
    docCurrent.Activate
    End Sub

  • +
    0 Votes
    pateoauchter

    With the help of a friend who knows Visual Basic, and some digging through the internet (thanks go to http://wordtips.vitalnews.com/Pages/T1870_Highlight_Words_from_a_Word_List.html), was able to get a quasi-highlight-macro to run in MSWord.

    The macro still has some flaws. The "Find All Word Forms" option cannot handle a non-alphabet character, so it won't search the phrases "can not", "has to", "have to" and "such as". Also, for some reason, the "Find All Word Forms" option will not find any instance of a text string if that string happens also to appear in a heading (perhaps this is a formatting parameter that needs to be set to false).

    So, the macro no longer adds highlighting to words as that seemed to be one of the problems. Rather, the macro finds the desired words and changes their font to size 18.

    The macro code is printed below.

    Sub callout_txt_strings()
    Dim sCheckDoc As String
    Dim docRef As Document
    Dim docCurrent As Document
    Dim wrdRef As Object

    sCheckDoc = "c:\checklist.doc"
    Set docCurrent = Selection.Document
    Set docRef = Documents.Open(sCheckDoc)
    docCurrent.Activate

    With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    '.Replacement.Font.Bold = True
    .Replacement.Font.Size = 18
    .Replacement.Text = "^&"
    .Forward = True
    .Format = True
    .MatchWholeWord = False
    .MatchAllWordForms = True
    .MatchCase = False
    .MatchWildcards = False
    End With

    For Each wrdRef In docRef.Words
    If Asc(Left(wrdRef, 1)) > 32 Then
    With Selection.Find
    .Wrap = wdFindContinue
    .Text = wrdRef
    '.Replacement.Highlight = True
    .Execute Replace:=wdReplaceAll
    End With
    End If
    Next wrdRef

    docRef.Close
    docCurrent.Activate
    End Sub