Abbreviation and the message box

[Designingsally]

Hi ppl there

I got a code which highlights all the abbreviation present in a document.
But i want the code to be tweeked a bit. I want the macro to:
1. Highlight the abbreviation one by one.
2. After one abbreviation is highlighted a message box must be displayed.
3. The message shd be add THE before the abbreviation. It must have 2 button
REPLACE and DECLINE.
4. If the user clicks REPLACE "THE" must be added before the abbreviation.
If the user clicks DECLINE. The macro shd highlight UK in the document.
5. Step 3

Thanks for the help . I m a novice. I ll be glad if someone helps me with
this.


The code I got is this:


For example:

UN is not in UK.

The macro shd highlight UN.
A msg box must appear asking to add THE before UN. If the user clicks
REPLACE then THE must be added automatically.
After this action, the macro highlights UN. The
Public Sub subCountAcronyms()

Dim olWholeStory As Range
Dim slAcronym As String
Dim dbllT As Double
Dim rlWord As Range
Dim llWordCount As Long
Dim ilAcronymCount As Integer
Dim ilChr1 As Integer
Dim ilChr2 As Integer
Dim ilStyleAcronymCount As Integer
Dim rlStyle As Style
Dim rlStyles As Styles
Dim slNormalStyle As String

Application.DisplayStatusBar = True
dbllT = Timer
Set olWholeStory = Selection.Range
olWholeStory.WholeStory

slNormalStyle = ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal).NameLocal
llWordCount = 0
ilAcronymCount = 0
ilStyleAcronymCount = 0

' Go through the Doc word by word.
For Each rlWord In olWholeStory.Words
StatusBar = rlWord.Text
llWordCount = llWordCount + 1
If Len(rlWord) > 1 Then

ilChr2 = Asc(Mid$(rlWord.Text, 2, 1))
Select Case ilChr2
Case Is < 65, Is > 90
' 2nd Chr Not upper case.
Case Else
' 2nd Chr is upper case.

ilChr1 = Asc(Mid$(rlWord.Text, 1, 1))
Select Case ilChr1
Case Is < 65, Is > 90
' 1st Chr Not upper case.
Case Else
' 1st Chr is upper case.

' Is the word in "normal" style?
If rlWord.Style <> slNormalStyle Then
ilStyleAcronymCount = ilStyleAcronymCount + 1
rlWord.HighlightColorIndex = wdBrightGreen
Else
rlWord.HighlightColorIndex = wdPink
End If

' Do something with the acronym.
subWriteAcronym rlWord.Text
MsgBox (" Replace it with THE"), 76
ilAcronymCount = ilAcronymCount + 1
End Select
End Select
End If
Next rlWord

StatusBar = Round((Timer - dbllT), 1) _
& "secs " & llWordCount & " Words " _
& ilAcronymCount & " Acronyms " _
& ilStyleAcronymCount & " Acronyms not in Normal Styale "
End Sub
Public Sub subWriteAcronym(spAcronym As String)
'MsgBox spAcronym

End Sub

 

[Jean-Guy Marcil]

Designingsally was telling us:
Designingsally nous racontait que :

Hi ppl there

I got a code which highlights all the abbreviation present in a
document. But i want the code to be tweeked a bit. I want the macro
to:
1. Highlight the abbreviation one by one.
2. After one abbreviation is highlighted a message box must be
displayed.
3. The message shd be add THE before the abbreviation. It must have 2
button REPLACE and DECLINE.
4. If the user clicks REPLACE "THE" must be added before the
abbreviation. If the user clicks DECLINE. The macro shd highlight UK
in the document.
5. Step 3

Thanks for the help . I m a novice. I ll be glad if someone helps me
with this.


The code I got is this:


For example:

UN is not in UK.

The macro shd highlight UN.
A msg box must appear asking to add THE before UN. If the user clicks
REPLACE then THE must be added automatically.
After this action, the macro highlights UN. The
Public Sub subCountAcronyms()

Dim olWholeStory As Range
Dim slAcronym As String
Dim dbllT As Double
Dim rlWord As Range
Dim llWordCount As Long
Dim ilAcronymCount As Integer
Dim ilChr1 As Integer
Dim ilChr2 As Integer
Dim ilStyleAcronymCount As Integer
Dim rlStyle As Style
Dim rlStyles As Styles
Dim slNormalStyle As String

Application.DisplayStatusBar = True
dbllT = Timer
Set olWholeStory = Selection.Range
olWholeStory.WholeStory

slNormalStyle =
ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal).NameLocal
llWordCount = 0
ilAcronymCount = 0
ilStyleAcronymCount = 0

' Go through the Doc word by word.
For Each rlWord In olWholeStory.Words
StatusBar = rlWord.Text
llWordCount = llWordCount + 1
If Len(rlWord) > 1 Then

ilChr2 = Asc(Mid$(rlWord.Text, 2, 1))
Select Case ilChr2
Case Is < 65, Is > 90
' 2nd Chr Not upper case.
Case Else
' 2nd Chr is upper case.

ilChr1 = Asc(Mid$(rlWord.Text, 1, 1))
Select Case ilChr1
Case Is < 65, Is > 90
' 1st Chr Not upper case.
Case Else
' 1st Chr is upper case.

' Is the word in "normal" style?
If rlWord.Style <> slNormalStyle Then
ilStyleAcronymCount = ilStyleAcronymCount + 1
rlWord.HighlightColorIndex = wdBrightGreen
Else
rlWord.HighlightColorIndex = wdPink
End If

' Do something with the acronym.
subWriteAcronym rlWord.Text
MsgBox (" Replace it with THE"), 76
ilAcronymCount = ilAcronymCount + 1
End Select
End Select
End If
Next rlWord

StatusBar = Round((Timer - dbllT), 1) _
& "secs " & llWordCount & " Words " _
& ilAcronymCount & " Acronyms " _
& ilStyleAcronymCount & " Acronyms not in Normal Styale "
End Sub
Public Sub subWriteAcronym(spAcronym As String)
'MsgBox spAcronym

End Sub

Try this:

Option Explicit

Public Sub subCountAcronyms()

Dim olWholeStory As Range
Dim slAcronym As String
Dim dbllT As Double
Dim rlWord As Range
Dim llWordCount As Long
Dim ilAcronymCount As Integer
Dim ilChr1 As Integer
Dim ilChr2 As Integer
Dim ilStyleAcronymCount As Integer
Dim rlStyle As Style
Dim rlStyles As Styles
Dim slNormalStyle As String
Dim boolIsNormal As Boolean

Application.DisplayStatusBar = True
dbllT = Timer
Set olWholeStory = Selection.Range
olWholeStory.WholeStory

slNormalStyle =
ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal).NameLocal
llWordCount = 0
ilAcronymCount = 0
ilStyleAcronymCount = 0

' Go through the Doc word by word.
For Each rlWord In olWholeStory.Words
StatusBar = rlWord.Text
llWordCount = llWordCount + 1
If Len(rlWord) > 1 Then

ilChr2 = Asc(Mid$(rlWord.Text, 2, 1))
Select Case ilChr2
Case Is < 65, Is > 90
' 2nd Chr Not upper case.
Case Else
' 2nd Chr is upper case.

ilChr1 = Asc(Mid$(rlWord.Text, 1, 1))
Select Case ilChr1
Case Is < 65, Is > 90
' 1st Chr Not upper case.
Case Else
' 1st Chr is upper case.

' Is the word in "normal" style?
If rlWord.Style <> slNormalStyle Then
ilStyleAcronymCount = ilStyleAcronymCount + 1
rlWord.HighlightColorIndex = wdBrightGreen
boolIsNormal = False
Else
rlWord.HighlightColorIndex = wdPink
boolIsNormal = True
End If

' Do something with the acronym.
subWriteAcronym rlWord, boolIsNormal
ilAcronymCount = ilAcronymCount + 1
End Select
End Select
End If
Next rlWord

StatusBar = Round((Timer - dbllT), 1) _
& "secs " & llWordCount & " Words " _
& ilAcronymCount & " Acronyms " _
& ilStyleAcronymCount & " Acronyms not in Normal Styale "
End Sub
Public Sub subWriteAcronym(spAcronym As Range, boolPink As Boolean)

If MsgBox("Do you want to add ""The"" in front of the current acronym?", _
vbYesNo, "Add ""The""") = vbYes Then
spAcronym.InsertBefore "the "
If boolPink Then
spAcronym.HighlightColorIndex = wdPink
Else
spAcronym.HighlightColorIndex = wdBrightGreen
End If
End If

End Sub

 

[Designingsally]

Jean,

thanks for the reply. It did help me. But as I started to demonstrate ur
code under different suitation i found that when macros even though THE
exists before abbreviation it continues to ask if THE should be added before
the acromyn. I dont want that to happen. Cos it does NOT make sense if macros
continue to highlight acrynmn when THE is already placed before that.

Can you help me out with the solution? Thanks in advance.
Code i tired is as below:

Sub TheBeforeAcronym()
Dim myRange As Range
Dim rslt As VbMsgBoxResult

Set myRange = ActiveDocument.Range
With myRange
.Start = 0
Do While .Find.Execute(FindText:="<([A-Z]{2,})>", _
MatchWildcards:=True, _
Wrap:=wdFindStop, Forward:=True) = True
myRange.Select
rslt = Msgbox(Prompt:="Add 'the' before this acronym?", _
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then
Exit Sub
End If
If rslt = vbYes Then
Selection.InsertBefore "the "
.Collapse Direction:=wdCollapseEnd
End If
.Collapse Direction:=wdCollapseEnd
Loop
Selection.Collapse Direction:=wdCollapseEnd


End With
Set myRange = Nothing
End Sub

 

[Greg Maxey]

You will need to check to see what preceeds the found text. Something like
this which will need to be cleaned up to handle instances when there is no
text before

Sub TheBeforeAcronym()
Dim myRange As Range
Dim oRng As Range
Dim rslt As VbMsgBoxResult
Set myRange = ActiveDocument.Range
With myRange.Find
.Text = "<([A-Z]{2,})>"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
While .Execute
myRange.Select
Set oRng = myRange.Duplicate
oRng.Move wdCharacter, -5
oRng.MoveEnd wdCharacter, 4
If Not oRng.Text = "the " Then
rslt = MsgBox(Prompt:="Add 'the' before this acronym?",
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then Exit Sub
If rslt = vbYes Then
Selection.InsertBefore "the "
myRange.Collapse wdCollapseEnd
End If
End If
myRange.Collapse wdCollapseEnd
Wend
End With
Set myRange = Nothing
End Sub

Jean,

thanks for the reply. It did help me. But as I started to demonstrate
ur code under different suitation i found that when macros even
though THE exists before abbreviation it continues to ask if THE
should be added before the acromyn. I dont want that to happen. Cos
it does NOT make sense if macros continue to highlight acrynmn when
THE is already placed before that.

Can you help me out with the solution? Thanks in advance.
Code i tired is as below:

Sub TheBeforeAcronym()
Dim myRange As Range
Dim rslt As VbMsgBoxResult

Set myRange = ActiveDocument.Range
With myRange
.Start = 0
Do While .Find.Execute(FindText:="<([A-Z]{2,})>", _
MatchWildcards:=True, _
Wrap:=wdFindStop, Forward:=True) = True
myRange.Select
rslt = Msgbox(Prompt:="Add 'the' before this acronym?", _
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then
Exit Sub
End If
If rslt = vbYes Then
Selection.InsertBefore "the "
.Collapse Direction:=wdCollapseEnd
End If
.Collapse Direction:=wdCollapseEnd
Loop
Selection.Collapse Direction:=wdCollapseEnd


End With
Set myRange = Nothing
End Sub

Designingsally was telling us:
Designingsally nous racontait que :


Try this:

Option Explicit

Public Sub subCountAcronyms()

Dim olWholeStory As Range
Dim slAcronym As String
Dim dbllT As Double
Dim rlWord As Range
Dim llWordCount As Long
Dim ilAcronymCount As Integer
Dim ilChr1 As Integer
Dim ilChr2 As Integer
Dim ilStyleAcronymCount As Integer
Dim rlStyle As Style
Dim rlStyles As Styles
Dim slNormalStyle As String
Dim boolIsNormal As Boolean

Application.DisplayStatusBar = True
dbllT = Timer
Set olWholeStory = Selection.Range
olWholeStory.WholeStory

slNormalStyle =
ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal).NameLocal
llWordCount = 0
ilAcronymCount = 0
ilStyleAcronymCount = 0

' Go through the Doc word by word.
For Each rlWord In olWholeStory.Words
StatusBar = rlWord.Text
llWordCount = llWordCount + 1
If Len(rlWord) > 1 Then

ilChr2 = Asc(Mid$(rlWord.Text, 2, 1))
Select Case ilChr2
Case Is < 65, Is > 90
' 2nd Chr Not upper case.
Case Else
' 2nd Chr is upper case.

ilChr1 = Asc(Mid$(rlWord.Text, 1, 1))
Select Case ilChr1
Case Is < 65, Is > 90
' 1st Chr Not upper case.
Case Else
' 1st Chr is upper case.

' Is the word in "normal" style?
If rlWord.Style <> slNormalStyle Then
ilStyleAcronymCount = ilStyleAcronymCount + 1
rlWord.HighlightColorIndex = wdBrightGreen
boolIsNormal = False
Else
rlWord.HighlightColorIndex = wdPink
boolIsNormal = True
End If

' Do something with the acronym.
subWriteAcronym rlWord, boolIsNormal
ilAcronymCount = ilAcronymCount + 1
End Select
End Select
End If
Next rlWord

StatusBar = Round((Timer - dbllT), 1) _
& "secs " & llWordCount & " Words " _
& ilAcronymCount & " Acronyms " _
& ilStyleAcronymCount & " Acronyms not in Normal Styale "
End Sub
Public Sub subWriteAcronym(spAcronym As Range, boolPink As Boolean)

If MsgBox("Do you want to add ""The"" in front of the current
acronym?", _ vbYesNo, "Add ""The""") = vbYes Then
spAcronym.InsertBefore "the "
If boolPink Then
spAcronym.HighlightColorIndex = wdPink
Else
spAcronym.HighlightColorIndex = wdBrightGreen
End If
End If

End Sub

 

[Designingsally]

i want the macros to skip inserting THE before TABLE. is it possible?
Thanks in advance

Sally

if the macros were to search the sample data
UNO
ROCK
ROLLING
TABLE
ROLL
RAMS

Code is
Sub TheBeforeAcronym()
Dim myRange As Range
Dim orng As Range
Dim rslt As VbMsgBoxResult
Set myRange = ActiveDocument.Range
With myRange.FInd
..Text = "<([A-Z]{3,})>"
..MatchWildcards = True
..Wrap = wdFindStop
..Forward = True
While .Execute
myRange.Select
Set orng = myRange.Duplicate
orng.Move wdCharacter, -5
orng.MoveEnd wdCharacter, 4
If Not orng.Text = "the " Then
rslt = Msgbox(Prompt:="Add 'the' before this acronym?",
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then Exit Sub
If rslt = vbYes Then
Selection.InsertBefore "the "
myRange.Collapse wdCollapseEnd
End If
End If
myRange.Collapse wdCollapseEnd
Wend
End With
Set myRange = Nothing
End Sub
--
I believe in Hope.

DesigningSally

You will need to check to see what preceeds the found text. Something like
this which will need to be cleaned up to handle instances when there is no
text before

Sub TheBeforeAcronym()
Dim myRange As Range
Dim oRng As Range
Dim rslt As VbMsgBoxResult
Set myRange = ActiveDocument.Range
With myRange.Find
.Text = "<([A-Z]{2,})>"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
While .Execute
myRange.Select
Set oRng = myRange.Duplicate
oRng.Move wdCharacter, -5
oRng.MoveEnd wdCharacter, 4
If Not oRng.Text = "the " Then
rslt = MsgBox(Prompt:="Add 'the' before this acronym?",
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then Exit Sub
If rslt = vbYes Then
Selection.InsertBefore "the "
myRange.Collapse wdCollapseEnd
End If
End If
myRange.Collapse wdCollapseEnd
Wend
End With
Set myRange = Nothing
End Sub

Jean,

thanks for the reply. It did help me. But as I started to demonstrate
ur code under different suitation i found that when macros even
though THE exists before abbreviation it continues to ask if THE
should be added before the acromyn. I dont want that to happen. Cos
it does NOT make sense if macros continue to highlight acrynmn when
THE is already placed before that.

Can you help me out with the solution? Thanks in advance.
Code i tired is as below:

Sub TheBeforeAcronym()
Dim myRange As Range
Dim rslt As VbMsgBoxResult

Set myRange = ActiveDocument.Range
With myRange
.Start = 0
Do While .Find.Execute(FindText:="<([A-Z]{2,})>", _
MatchWildcards:=True, _
Wrap:=wdFindStop, Forward:=True) = True
myRange.Select
rslt = Msgbox(Prompt:="Add 'the' before this acronym?", _
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then
Exit Sub
End If
If rslt = vbYes Then
Selection.InsertBefore "the "
.Collapse Direction:=wdCollapseEnd
End If
.Collapse Direction:=wdCollapseEnd
Loop
Selection.Collapse Direction:=wdCollapseEnd


End With
Set myRange = Nothing
End Sub

Designingsally was telling us:
Designingsally nous racontait que :

Hi ppl there

I got a code which highlights all the abbreviation present in a
document. But i want the code to be tweeked a bit. I want the macro
to:
1. Highlight the abbreviation one by one.
2. After one abbreviation is highlighted a message box must be
displayed.
3. The message shd be add THE before the abbreviation. It must have
2 button REPLACE and DECLINE.
4. If the user clicks REPLACE "THE" must be added before the
abbreviation. If the user clicks DECLINE. The macro shd highlight UK
in the document.
5. Step 3

Thanks for the help . I m a novice. I ll be glad if someone helps me
with this.


The code I got is this:


For example:

UN is not in UK.

The macro shd highlight UN.
A msg box must appear asking to add THE before UN. If the user
clicks REPLACE then THE must be added automatically.
After this action, the macro highlights UN. The
Public Sub subCountAcronyms()

Dim olWholeStory As Range
Dim slAcronym As String
Dim dbllT As Double
Dim rlWord As Range
Dim llWordCount As Long
Dim ilAcronymCount As Integer
Dim ilChr1 As Integer
Dim ilChr2 As Integer
Dim ilStyleAcronymCount As Integer
Dim rlStyle As Style
Dim rlStyles As Styles
Dim slNormalStyle As String

Application.DisplayStatusBar = True
dbllT = Timer
Set olWholeStory = Selection.Range
olWholeStory.WholeStory

slNormalStyle =
ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal).NameLocal
llWordCount = 0
ilAcronymCount = 0
ilStyleAcronymCount = 0

' Go through the Doc word by word.
For Each rlWord In olWholeStory.Words
StatusBar = rlWord.Text
llWordCount = llWordCount + 1
If Len(rlWord) > 1 Then

ilChr2 = Asc(Mid$(rlWord.Text, 2, 1))
Select Case ilChr2
Case Is < 65, Is > 90
' 2nd Chr Not upper case.
Case Else
' 2nd Chr is upper case.

ilChr1 = Asc(Mid$(rlWord.Text, 1, 1))
Select Case ilChr1
Case Is < 65, Is > 90
' 1st Chr Not upper case.
Case Else
' 1st Chr is upper case.

' Is the word in "normal" style?
If rlWord.Style <> slNormalStyle Then
ilStyleAcronymCount = ilStyleAcronymCount + 1
rlWord.HighlightColorIndex = wdBrightGreen
Else
rlWord.HighlightColorIndex = wdPink
End If

' Do something with the acronym.
subWriteAcronym rlWord.Text
MsgBox (" Replace it with THE"), 76
ilAcronymCount = ilAcronymCount + 1
End Select
End Select
End If
Next rlWord

StatusBar = Round((Timer - dbllT), 1) _
& "secs " & llWordCount & " Words " _
& ilAcronymCount & " Acronyms " _
& ilStyleAcronymCount & " Acronyms not in Normal Styale "
End Sub
Public Sub subWriteAcronym(spAcronym As String)
'MsgBox spAcronym

End Sub

Try this:

Option Explicit

Public Sub subCountAcronyms()

Dim olWholeStory As Range
Dim slAcronym As String
Dim dbllT As Double
Dim rlWord As Range
Dim llWordCount As Long
Dim ilAcronymCount As Integer
Dim ilChr1 As Integer
Dim ilChr2 As Integer
Dim ilStyleAcronymCount As Integer
Dim rlStyle As Style
Dim rlStyles As Styles
Dim slNormalStyle As String
Dim boolIsNormal As Boolean

Application.DisplayStatusBar = True
dbllT = Timer
Set olWholeStory = Selection.Range
olWholeStory.WholeStory

slNormalStyle =
ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal).NameLocal
llWordCount = 0
ilAcronymCount = 0
ilStyleAcronymCount = 0

' Go through the Doc word by word.
For Each rlWord In olWholeStory.Words
StatusBar = rlWord.Text
llWordCount = llWordCount + 1
If Len(rlWord) > 1 Then

ilChr2 = Asc(Mid$(rlWord.Text, 2, 1))
Select Case ilChr2
Case Is < 65, Is > 90
' 2nd Chr Not upper case.
Case Else
' 2nd Chr is upper case.

ilChr1 = Asc(Mid$(rlWord.Text, 1, 1))
Select Case ilChr1
Case Is < 65, Is > 90
' 1st Chr Not upper case.
Case Else
' 1st Chr is upper case.

' Is the word in "normal" style?
If rlWord.Style <> slNormalStyle Then
ilStyleAcronymCount = ilStyleAcronymCount + 1
rlWord.HighlightColorIndex = wdBrightGreen
boolIsNormal = False
Else
rlWord.HighlightColorIndex = wdPink
boolIsNormal = True
End If

' Do something with the acronym.
subWriteAcronym rlWord, boolIsNormal
ilAcronymCount = ilAcronymCount + 1
End Select
End Select
End If
Next rlWord

StatusBar = Round((Timer - dbllT), 1) _
& "secs " & llWordCount & " Words " _
& ilAcronymCount & " Acronyms " _
& ilStyleAcronymCount & " Acronyms not in Normal Styale "
End Sub
Public Sub subWriteAcronym(spAcronym As Range, boolPink As Boolean)

If MsgBox("Do you want to add ""The"" in front of the current
acronym?", _ vbYesNo, "Add ""The""") = vbYes Then
spAcronym.InsertBefore "the "
If boolPink Then
spAcronym.HighlightColorIndex = wdPink
Else
spAcronym.HighlightColorIndex = wdBrightGreen
End If
End If

End Sub

 

[Graham Mayor]

See your later duplicate post. Please don't duplicate posts.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

i want the macros to skip inserting THE before TABLE. is it possible?
Thanks in advance

Sally

if the macros were to search the sample data
UNO
ROCK
ROLLING
TABLE
ROLL
RAMS

Code is
Sub TheBeforeAcronym()
Dim myRange As Range
Dim orng As Range
Dim rslt As VbMsgBoxResult
Set myRange = ActiveDocument.Range
With myRange.FInd
.Text = "<([A-Z]{3,})>"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
While .Execute
myRange.Select
Set orng = myRange.Duplicate
orng.Move wdCharacter, -5
orng.MoveEnd wdCharacter, 4
If Not orng.Text = "the " Then
rslt = Msgbox(Prompt:="Add 'the' before this acronym?",
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then Exit Sub
If rslt = vbYes Then
Selection.InsertBefore "the "
myRange.Collapse wdCollapseEnd
End If
End If
myRange.Collapse wdCollapseEnd
Wend
End With
Set myRange = Nothing
End Sub

You will need to check to see what preceeds the found text.
Something like this which will need to be cleaned up to handle
instances when there is no text before

Sub TheBeforeAcronym()
Dim myRange As Range
Dim oRng As Range
Dim rslt As VbMsgBoxResult
Set myRange = ActiveDocument.Range
With myRange.Find
.Text = "<([A-Z]{2,})>"
.MatchWildcards = True
.Wrap = wdFindStop
.Forward = True
While .Execute
myRange.Select
Set oRng = myRange.Duplicate
oRng.Move wdCharacter, -5
oRng.MoveEnd wdCharacter, 4
If Not oRng.Text = "the " Then
rslt = MsgBox(Prompt:="Add 'the' before this acronym?",
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then Exit Sub
If rslt = vbYes Then
Selection.InsertBefore "the "
myRange.Collapse wdCollapseEnd
End If
End If
myRange.Collapse wdCollapseEnd
Wend
End With
Set myRange = Nothing
End Sub

Jean,

thanks for the reply. It did help me. But as I started to
demonstrate ur code under different suitation i found that when
macros even though THE exists before abbreviation it continues to
ask if THE should be added before the acromyn. I dont want that to
happen. Cos it does NOT make sense if macros continue to highlight
acrynmn when THE is already placed before that.

Can you help me out with the solution? Thanks in advance.
Code i tired is as below:

Sub TheBeforeAcronym()
Dim myRange As Range
Dim rslt As VbMsgBoxResult

Set myRange = ActiveDocument.Range
With myRange
.Start = 0
Do While .Find.Execute(FindText:="<([A-Z]{2,})>", _
MatchWildcards:=True, _
Wrap:=wdFindStop, Forward:=True) = True
myRange.Select
rslt = Msgbox(Prompt:="Add 'the' before this acronym?", _
Buttons:=vbYesNoCancel)
If rslt = vbCancel Then
Exit Sub
End If
If rslt = vbYes Then
Selection.InsertBefore "the "
.Collapse Direction:=wdCollapseEnd
End If
.Collapse Direction:=wdCollapseEnd
Loop
Selection.Collapse Direction:=wdCollapseEnd


End With
Set myRange = Nothing
End Sub





Designingsally was telling us:
Designingsally nous racontait que :

Hi ppl there

I got a code which highlights all the abbreviation present in a
document. But i want the code to be tweeked a bit. I want the
macro to:
1. Highlight the abbreviation one by one.
2. After one abbreviation is highlighted a message box must be
displayed.
3. The message shd be add THE before the abbreviation. It must
have 2 button REPLACE and DECLINE.
4. If the user clicks REPLACE "THE" must be added before the
abbreviation. If the user clicks DECLINE. The macro shd highlight
UK in the document.
5. Step 3

Thanks for the help . I m a novice. I ll be glad if someone helps
me with this.


The code I got is this:


For example:

UN is not in UK.

The macro shd highlight UN.
A msg box must appear asking to add THE before UN. If the user
clicks REPLACE then THE must be added automatically.
After this action, the macro highlights UN. The
Public Sub subCountAcronyms()

Dim olWholeStory As Range
Dim slAcronym As String
Dim dbllT As Double
Dim rlWord As Range
Dim llWordCount As Long
Dim ilAcronymCount As Integer
Dim ilChr1 As Integer
Dim ilChr2 As Integer
Dim ilStyleAcronymCount As Integer
Dim rlStyle As Style
Dim rlStyles As Styles
Dim slNormalStyle As String

Application.DisplayStatusBar = True
dbllT = Timer
Set olWholeStory = Selection.Range
olWholeStory.WholeStory

slNormalStyle =
ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal).NameLocal
llWordCount = 0
ilAcronymCount = 0
ilStyleAcronymCount = 0

' Go through the Doc word by word.
For Each rlWord In olWholeStory.Words
StatusBar = rlWord.Text
llWordCount = llWordCount + 1
If Len(rlWord) > 1 Then

ilChr2 = Asc(Mid$(rlWord.Text, 2, 1))
Select Case ilChr2
Case Is < 65, Is > 90
' 2nd Chr Not upper case.
Case Else
' 2nd Chr is upper case.

ilChr1 = Asc(Mid$(rlWord.Text, 1, 1))
Select Case ilChr1
Case Is < 65, Is > 90
' 1st Chr Not upper case.
Case Else
' 1st Chr is upper case.

' Is the word in "normal" style?
If rlWord.Style <> slNormalStyle Then
ilStyleAcronymCount = ilStyleAcronymCount + 1
rlWord.HighlightColorIndex = wdBrightGreen
Else
rlWord.HighlightColorIndex = wdPink
End If

' Do something with the acronym.
subWriteAcronym rlWord.Text
MsgBox (" Replace it with THE"), 76
ilAcronymCount = ilAcronymCount + 1
End Select
End Select
End If
Next rlWord

StatusBar = Round((Timer - dbllT), 1) _
& "secs " & llWordCount & " Words " _
& ilAcronymCount & " Acronyms " _
& ilStyleAcronymCount & " Acronyms not in Normal Styale "
End Sub
Public Sub subWriteAcronym(spAcronym As String)
'MsgBox spAcronym

End Sub

Try this:

Option Explicit

Public Sub subCountAcronyms()

Dim olWholeStory As Range
Dim slAcronym As String
Dim dbllT As Double
Dim rlWord As Range
Dim llWordCount As Long
Dim ilAcronymCount As Integer
Dim ilChr1 As Integer
Dim ilChr2 As Integer
Dim ilStyleAcronymCount As Integer
Dim rlStyle As Style
Dim rlStyles As Styles
Dim slNormalStyle As String
Dim boolIsNormal As Boolean

Application.DisplayStatusBar = True
dbllT = Timer
Set olWholeStory = Selection.Range
olWholeStory.WholeStory

slNormalStyle =
ActiveDocument.Styles(WdBuiltinStyle.wdStyleNormal).NameLocal
llWordCount = 0
ilAcronymCount = 0
ilStyleAcronymCount = 0

' Go through the Doc word by word.
For Each rlWord In olWholeStory.Words
StatusBar = rlWord.Text
llWordCount = llWordCount + 1
If Len(rlWord) > 1 Then

ilChr2 = Asc(Mid$(rlWord.Text, 2, 1))
Select Case ilChr2
Case Is < 65, Is > 90
' 2nd Chr Not upper case.
Case Else
' 2nd Chr is upper case.

ilChr1 = Asc(Mid$(rlWord.Text, 1, 1))
Select Case ilChr1
Case Is < 65, Is > 90
' 1st Chr Not upper case.
Case Else
' 1st Chr is upper case.

' Is the word in "normal" style?
If rlWord.Style <> slNormalStyle Then
ilStyleAcronymCount = ilStyleAcronymCount + 1
rlWord.HighlightColorIndex = wdBrightGreen
boolIsNormal = False
Else
rlWord.HighlightColorIndex = wdPink
boolIsNormal = True
End If

' Do something with the acronym.
subWriteAcronym rlWord, boolIsNormal
ilAcronymCount = ilAcronymCount + 1
End Select
End Select
End If
Next rlWord

StatusBar = Round((Timer - dbllT), 1) _
& "secs " & llWordCount & " Words " _
& ilAcronymCount & " Acronyms " _
& ilStyleAcronymCount & " Acronyms not in Normal Styale "
End Sub
Public Sub subWriteAcronym(spAcronym As Range, boolPink As Boolean)

If MsgBox("Do you want to add ""The"" in front of the current
acronym?", _ vbYesNo, "Add ""The""") = vbYes Then
spAcronym.InsertBefore "the "
If boolPink Then
spAcronym.HighlightColorIndex = wdPink
Else
spAcronym.HighlightColorIndex = wdBrightGreen
End If
End If

End Sub