Word 2003 - VBA to find specific terms

[Spurious]

Hi all,

I am looking to code a macro that goes through a text and finds every word that starts with a capital letter.
Those words represent defined terms.

The problem here is, that sometimes two or more words are capitalized and they combined are the defined term.

E.g. Maturity Date would be an example.

So, I need a macro that goes through a text and finds all of those terms. Hickups include starts of sentences, punctuation in between and different number of words building a defined term.


I am not sure, if I was clear with what I wanted to code. Please ask questions, if something is unclear.

Thanks!

 

[Spurious]

I did make two changes and your code is working very well, I am now in the process of tweaking it.

Does your code really ignore Maturity (Day), but counts Maturity(i)?

 

[Spurious]

Ok, after trying a few things and getting more and more how Word VBA works, I found a solution:

If .Characters.Last.Next = "(" And .Characters.Last <> " " Then

This works for what I want it to work.


Thank you very much for your excellent help here!
I will update the thread with other problems I encounter.

 

[Macropod]

I did make two changes and your code is working very well, I am now in the process of tweaking it.

Does your code really ignore Maturity (Day), but counts Maturity(i)?

I've been out for a few hours. Mine counts Maturity(i) as one term as Maturity (Day) as two terms - Maturity and Day.

Here is the complete code:

Sub GetTerms()
Dim Rng As Range, i As Long, StrTxt As String
StrTxt = Chr(11)
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Text = "<[A-Z]*>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    Set Rng = .Duplicate
    With Rng
      While .Words.Last.Next.Characters.First Like "[A-Z]"
        .MoveEnd wdWord, 1
      Wend
      If .Characters.Last.Next = "(" Then
        .MoveEndUntil ")", wdForward
        .End = Rng.End + 1
      End If
      If InStr(StrTxt, Chr(11) & Trim(.Text) & Chr(11)) = 0 Then
        StrTxt = StrTxt & Trim(.Text) & Chr(11)
        i = i + 1
      End If
    End With
    .Start = Rng.End
    .Find.Execute
  Loop
  StrTxt = Left(StrTxt, Len(StrTxt) - 1)
End With
  If Len(StrTxt) > 1 Then
    ActiveDocument.Range.InsertAfter vbCr & Chr(12) & "Possible Defined Terms" & StrTxt
  End If
MsgBox i & " possible 'Defined Term' expressions found."
End Sub

 

[Spurious]

Do you have a newer version of Office? I dont know, but it didnt work for me. I got it to work now, which is fine and I only added a small thing.

I got another question. Is there a way to select the words (instead of adding them to a string)? Basically, my end goal is, I want the user to go through the text and highlight/select every term.

 

[Macropod]

Developed in Word 2010, Tested in Word 2003. Identical results.

As for going through the document & highlighting, the macro could:
• higlight the 'possible terms' as it finds them, with no user interaction;
• compile the list (without outputting it), then ask the user whether to highlight all instances of a each term on a term-by-term basis; or
• skip building the list and simply stop at each possible term as it finds them and ask on a case-by-case basis.
Which do you want to do?

 

[Spurious]

Tried your macro again and it doesnt work, doesnt matter.

As for your question:
The 3rd solution would be ideal.

 

[Macropod]

Try:

Sub HiglightTerms()
Dim Rng As Range, Rslt
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Text = "<[A-Z]*>"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    Set Rng = .Duplicate
    With Rng
      While .Words.Last.Next.Characters.First Like "[A-Z]"
        .MoveEnd wdWord, 1
      Wend
      If .Characters.Last.Next = "(" And .Characters.Last <> " " Then
        .MoveEndUntil ")", wdForward
        .End = Rng.End + 1
      End If
      .Select
      Rslt = MsgBox("Highlight the marked string:" & vbCr & _
        .Text, vbYesNoCancel, "Defined Term Highlighter")
      If Rslt = vbCancel Then Exit Sub
      If Rslt = vbYes Then .HighlightColorIndex = wdBrightGreen
    End With
    .Start = Rng.End
    .Find.Execute
  Loop
End With
MsgBox "Finished"
End Sub

 

[Spurious]

Thank you, works wonderful!

 

[Spurious]

Ok, I got another question:
How do I start at the current cursor position rather than the beginning of the document?
I dont really know how I could incoporate that into your code, because it isnt using Selection.

 

[Spurious]

Ok, I got another question:
How do I start at the current cursor position rather than the beginning of the document?
I dont really know how I could incoporate that into your code, because it isnt using Selection.

Nevermind, figured it out.

With ActiveDocument.Range
    .Start = Selection.Start

Easy and logical!