none
Creating a List feature with a find command? RRS feed

  • Question

  • Hello, first post here.

    I'm looking for a way to make a VBA code in Word more user friendly for updates. I want the intended search to reference multiple values through one code (dimension) so updating the list just requires to criteria to be updated, rather than multiple strands of the code with a changed text.

    Current code:

    Options.DefaultHighlightColorIndex = wdYellow
    
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Highlight = True
        With Selection.Find
            .Text = "Will"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchPhrase = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Highlight = True
        With Selection.Find
            .Text = "jr."
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchPhrase = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        
    
    'Code repeats with several more variations such as "should" and "in order to"
    
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    

    Here is an example of how I see this working...

    Options.DefaultHighlightColorIndex = wdYellow
    
    Dim Text as String
    
    Text = "Will, Jr., Can't, in order to"
    
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Highlight = True
        With Selection.Find
            .Text = Text
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = True
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchPhrase = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        
    
    

    • Moved by Youjun Tang Tuesday, July 7, 2015 9:43 AM more appropriate
    • Moved by Youjun Tang Tuesday, July 7, 2015 9:53 AM more appropriate
    Monday, July 6, 2015 6:32 PM

Answers

  • Try something along the lines of the following. In the demo macro's case, three arrays are used to highlight words in different colours.

    Sub Demo()
    Application.ScreenUpdating = False
    Dim arrWords, i As Long
    With ActiveDocument.Range.Find
      Options.DefaultHighlightColorIndex = wdBrightGreen
      arrWords = Array("very low", "low")
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = True
      .Replacement.Text = "^&"
      .Replacement.Highlight = True
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      arrWords = Array("moderate", "medium", "high")
      Options.DefaultHighlightColorIndex = wdYellow
      .Replacement.Highlight = True
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      Options.DefaultHighlightColorIndex = wdRed
      arrWords = Array("very high", "extreme")
      .Replacement.Highlight = True
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
    End With
    Application.ScreenUpdating = True
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]



    • Edited by macropodMVP Wednesday, July 8, 2015 1:17 AM Code revision
    • Marked as answer by Kuljack Monday, July 13, 2015 12:53 PM
    Wednesday, July 8, 2015 1:15 AM

All replies

  • Hi Kuljack,

    Your issue is related to VBA in Word, I help you to move the post to word for developer forum for help.

    Regards,
    Youjun Tang


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, July 7, 2015 9:54 AM
  • Try something along the lines of the following. In the demo macro's case, three arrays are used to highlight words in different colours.

    Sub Demo()
    Application.ScreenUpdating = False
    Dim arrWords, i As Long
    With ActiveDocument.Range.Find
      Options.DefaultHighlightColorIndex = wdBrightGreen
      arrWords = Array("very low", "low")
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = True
      .Replacement.Text = "^&"
      .Replacement.Highlight = True
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      arrWords = Array("moderate", "medium", "high")
      Options.DefaultHighlightColorIndex = wdYellow
      .Replacement.Highlight = True
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
      Options.DefaultHighlightColorIndex = wdRed
      arrWords = Array("very high", "extreme")
      .Replacement.Highlight = True
      For i = 0 To UBound(arrWords)
        .Text = arrWords(i)
        .Execute Replace:=wdReplaceAll
      Next
    End With
    Application.ScreenUpdating = True
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]



    • Edited by macropodMVP Wednesday, July 8, 2015 1:17 AM Code revision
    • Marked as answer by Kuljack Monday, July 13, 2015 12:53 PM
    Wednesday, July 8, 2015 1:15 AM
  • Thank you Youjun, I had difficulty finding the correct forum when preparing the post. I'll be more mindful in future posts!
    Monday, July 13, 2015 12:52 PM
  • This is working perfect, I appreciate the revision. Very much streamlined from my original and exactly what was needed!
    Monday, July 13, 2015 12:53 PM