Macro to search all words for a specific character

[musicgold]

Hi,

I am trying to create a macro that will search and highlight all words in a Word document with a specific character. For example I want to be able to highlight all words with a ‘W’ in them.

Is that possible?

Thanks,

MG.

[macropod]

Hi MG,

You could do it with a macro like:
Sub BoldSpecial()
Dim oRng As Range, fRng As Range, StrText As String
Application.ScreenUpdating = False
StrText = InputBox("Character to Find", "Bold Words with Special Characters")
With Selection
Set oRng = .Range
With .Find
.ClearFormatting
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Text = StrText
With .Replacement
.Text = ""
.ClearFormatting
.Highlight = True
End With
.Execute
End With
Do While .Find.Found
Set fRng = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End)
With fRng
.Start = .Words(1).Start
.End = .Words(1).End - 1
.HighlightColorIndex = wdYellow
.Collapse Direction:=wdCollapseEnd
End With
.Find.Execute
Loop
End With
oRng.Select
Set fRng = Nothing
Set oRng = Nothing
Application.ScreenUpdating = True
End Sub

[musicgold]

macropod,

Thanks a lot. It works great. I spent my whole day on this problem.
Just a follow up question, if you don't mind.

I need to delete all words not containing "W", so the doc will contain only words with "W". The following is my code, which is not working.



Public Sub Select_words()
Dim Singleword As String
Dim Storage As String
Dim rDcm As Range
Dim i As Integer

Set rDcm = ActiveDocument.Range

Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=1
'go to the start of the doc

For i = 1 To Selection.Range.Words.Count
If InStr(Selection.Text, "W") Then
Selection.GoTo wdGoToNext

Else

Selection.Delete 'delete the word if doesn't contain a "W"

End If
Next
End Sub



Thanks.

[macropod]

Hi MG,

Deleting is a rather different proposition from highlighting. It would have been helpful had you said that's what you wanted to do from the outset.

Since I've already given you the highlighting code, you can delete everything that isn't highlighted by making the following changes:
1. Delete '- 1' from the line '.End = .Words(1).End - 1'
2. After the edited line that now reads '.End = .Words(1).End' insert the following line:

If .Characters.Last <> " " Then .InsertAfter " "
3. After the line 'oRng.Select' insert the following code:
With ActiveDocument.Range
With .Find
.Text = ""
.Highlight = False
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
.HighlightColorIndex = wdNoHighlight
End With

[musicgold]

Thanks a lot.
I am sorry about the confusion. I was hoping to first highlight the words and then use manual 'replace' to remove the un-highlighted words. But I couldn't do that too.

BTW, is it possible to do the following using the manual 'find and replace'?



With .Find
.Text = ""
.Highlight = False 'not sure how this can be done manually
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With

[macropod]

Hi MG,

Sure it's possible - with the Find box selected, click on Format > Highlight twice. The Find & Replace boxes should both be empty for this.

[musicgold]

Oh ! got it. Thanks a lot macropod.:bow:

[musicgold]

Hi macropod,

What changes should I make to the above code to find all words that end with a 't' in a word document?

Thanks.

[musicgold]

No worries. I got it to work. Here is my code.

Dim oRng As Range, fRng As Range, rngWord As Range, StrText As String
Set oRng = ActiveDocument.Content
For Each rngWord In oRng.Words

If rngWord.Characters.Count > 1 Then
If (rngWord.Characters.Item(rngWord.Characters.Count - 1) = "t" Then

rngWord.Characters.Item(rngWord.Characters.Count - 1).Bold = True
End If
End If
Next rngWord

[macropod]

Hi MG,

You'll like this: with the first macro I gave you, you could simply chnage the line:
.HighlightColorIndex = wdYellow
to:
.Font.Bold = True
input 't ' at the prompt. Executes much faster than your code too.

[musicgold]

Thanks a lot macropod.