Macro Help

[PhoenixTekBC]

I'm looking for a Word 2003 Macro that will utilize the CTRL-F (Find text) function.

What I'd like to ultimately have is a macro that asks for a group of words to look for and show the spots that they are at. Basically, instead of entering word by word, if I could enter all the words that I would want JUST ONCE and have it find them all.

Is this possible?

I'm not a macro wizard so any help would be appreciated!

Thanks
Brandon

[oracle128]

Not possible utilizing the Find function, but you might have some luck searching for occurances of the words and changing their format, eg. highlighting them.

[PhoenixTekBC]

Can you help me out with this macro?

[oracle128]

I'm working on it, give me some time.

[oracle128]

'Prompt for words
Dim findStr As String
findStr = InputBox("What words to look for? Seperate with a semicolon (;).", "Find Words", "")
Dim words() As String
'Tokenize the input
'Find location of separator in the string
Dim i As Integer
i = 0
ReDim words(0)
'Loop through while there's still a delimiter
While InStr(1, findStr, ";", vbTextCompare)
Dim pos
pos = InStr(1, findStr, ";", vbTextCompare)
'Add another slot to the words array
ReDim Preserve words(UBound(words) + 1)
'Add the word to the array
words(i) = Left$(findStr, pos - 1)
'Remove the word (and that delimiter) from the findStr
findStr = Right$(findStr, Len(findStr) - pos)
i = i + 1
Wend

'If the user put a semicolon at the end of their input
If InStr(1, findStr, ";", vbTextCompare) > 1 Then
'Add the last search word to the array
ReDim Preserve words(UBound(words) + 1)
words(i) = Left$(findStr, Len(findStr) - 1)
Else
'Add the last search word to the array
ReDim Preserve words(UBound(words) + 1)
words(i) = findStr
End If

Dim l, u As Integer
l = LBound(words)
u = UBound(words)
i = l

'Loop through the words array
For i = l To u
'Use Find feature to search for this word
'Setup Find paramaters
With Selection.Find
.ClearFormatting
.Text = words(i)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
'Highlight with yellow
Selection.Range.HighlightColorIndex = wdYellow
'Move to next match
Selection.MoveRight
Loop
End With
Next

[PhoenixTekBC]

Thanks so much!:afro:

[oracle128]

Try using this code instead, it's much shorter. Basically, there's already a Split function, which makes about half my code unnecessary...
'Prompt for words
Dim findStr As String
findStr = InputBox("What words to look for? Seperate with a semicolon (;).", "Find Words", "")
Dim words() As String
'Tokenize the input
words() = Split(findStr,";")

Dim l, u As Integer
l = LBound(words)
u = UBound(words)
i = l

'Loop through the words array
For i = l To u
'Use Find feature to search for this word
'Setup Find paramaters
With Selection.Find
.ClearFormatting
.Text = words(i)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
'Highlight with yellow
Selection.Range.HighlightColorIndex = wdYellow
'Move to next match
Selection.MoveRight
Loop
End With
Next