Word VBA - Search a word and add/remove it

[netchie]

Hi,

I have a vba that I got from here to look for a word and removed it from text table. I played around with it and this time to look for a certain word and replace/remove it but no use for a VBA dummy like me. Any suggestions? What I am trying to do is:

1. The word "Done" is incomplete on my text table (header section). What I have is "Do" instead of "Done". I need to have a VBA to automatically add "ne" with it.



2. Remove the word "Pass" on text table.

3. The word "Color Mixed" is too long on text table that the next word "Final" truncates.


Thanks so much for your help!

netchie

[netchie]

Oh wait! I think I got it! Found it while surfing

Here is theVBA for those who needs similar VBA

Sub RemoveWord()
Dim rngStory As Range
For Each rngStory In ActiveDocument.StoryRanges
  With rngStory.Find
    .Text = "Do"
    .Replacement.Text = "Done
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
Next rngStory
End Sub

But still, to to the guys who always helping me here. You guys ROCK!

Thanks,
netchie

[netchie]

Found this while surfing and uses it to replace words(s). The problem is if the word searched by macro is correct, it still corrected the word plus moving the last letter.

Example: From "Replace" will be added "d" and changed it to "Replaced". Some are corrected but some that searched as "Replaced" will changed to "Replacedd" (adding another d).

How can I fix this?

Sub Replaced()
Dim myStoryRange As Range
'First search the main document using the Selection
With Selection.Find
  .Text = "Replace"
  .Replacement.Text = "Replaced"
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  .Execute Replace:=wdReplaceAll
End With
'Now search all other stories using Ranges
For Each myStoryRange In ActiveDocument.StoryRanges
  If myStoryRange.StoryType <> wdMainTextStory Then
    With myStoryRange.Find
      .Text = "Replace"
      .Replacement.Text = "Replaced"
      .Wrap = wdFindContinue
      .Execute Replace:=wdReplaceAll
    End With
    Do While Not (myStoryRange.NextStoryRange Is Nothing)
      Set myStoryRange = myStoryRange.NextStoryRange
      With myStoryRange.Find
        .Text = "De"
        .Replacement.Text = "Replaced"
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
      End With
    Loop
  End If
Next myStoryRange
End Sub

[macropod]

Hi netchie,

In your initial post, you indicated that you're trying to process the contents of a table. In that case, all the code for processing storyranges is superfluous. Furthermore, even within whatever range contains the table, your code doesn't restrict itself to the table - it will happily change text outside it as well. As for problems like Restricted > Restrictedd, that's because you haven't told Word to match whole words only.

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab.

[netchie]

Hi macropod

The problem that I am having is after generating a report, some of the words are not complete. So instead of going through them one by one, I am trying to create a macro to change them automatically but the problem is I don't know how to put each word and replace them. As you can see below, the one that I found is just changing one word. How and where can I insert on VBA another word to replace? or if there is a VBA where if I highlight the word and use the macro then it will be changed to the word I want?

[macropod]

Try something like:

Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table, FndList, RepList, i As Long
FndList = Array("Replace", "Do")
RepList = Array("Replaced", "Done")
With ActiveDocument
  For Each Tbl In .Tables
    With Tbl.Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWholeWord = True
      .Replacement.Text = "^&"
      .Wrap = wdFindStop
      For i = 0 To UBound(FndList)
        .Text = FndList(i)
        .Replacement.Text = RepList(i)
        .Execute Replace:=wdReplaceAll
      Next
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

The above code only looks in tables in the body of the document. To add more Find/Replace expressions, simply edit the two arrays - FndList & RepList.