Highlighting when two consecutive words are found more than once

[Roberto_harg]

Dear VBA Express

I'd like to try and create a word macro that will highlight words in a document if they come up more than once as a group. So for example if I take this text.

Alcohol (AD) and other substance abuse disorders (SAD) are highly comorbid with mental disorders. A large US study found an odds ratio of 2.7 for people with mental health having SAD. Post-traumatic stress disorder (PTSD) patients were also reported as 5 times as male and 1.7 times as female more likely to have AD or SAD (Regier et al., 1990). Childhood adversity (CA) is similarly linked, with population risks reported as 54% depression, 65% alcoholism, 67% suicide, and 50% drug abuse (Andersen & Teicher, 2009).

Then in the text below it would highlight the words I highlighted

substance abuse disorders are associated with mental disorders

It will just help me go through and condense the work because I have about 100 pages and for example where I say mental disorders about 60 times in the paper I could then after the first time it is used change it to MD instead and recover 30 words in my word count.

Thanks Rob

[gmaxey]

Sub ScratchMacro()
MsgBox "When you want to try to begin a macro. You start with a Sub Name () statement like shown above and you end with an End Sub" _
& " statement like shown below and everything in between (like this) is code steps to do the deed.", vbOKOnly, "VBA PRIMER"
End Sub

[Roberto_harg]

Thanks Gmaxey

I think it would be a really useful piece of code to have in the word forum pinned.
7,800,000 scientists exist in the world, every single one of them needs to regularly do this, so it could potentially be a massive hit with tens of thousands of people.

Rob

[gmaxey]

Roberto,

I poked you in the eye because this is not a code writing service. We are here to help YOU learn to write code. Not to write it for you. The concept is to teach you how to fish so you eat for a lifetime rather than give you a fish so you can eat today. However, this is your first post here and perhaps that was a bit harsh.

This is the sort of thing that you can do using arrays where you define what the "terms" are and what the associated acronyms are. With counters (to see if the term appears more than once) and with find and replace routines. Here is a fish.


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Dim arrTerms() As String
Dim arrAcr() As String
Dim lngIndex As Long, lngCount As Long
arrTerms = Split("alcohol,substance abuse disorders", ",")
arrAcr = Split("AD,SAD", ",")
For lngIndex = 0 To UBound(arrTerms)
Set oRng = ActiveDocument.Range
lngCount = 0
With oRng.Find
.Text = arrTerms(lngIndex)
.MatchCase = False
Do While .Execute
lngCount = lngCount + 1
If lngCount > 1 Then Exit Do
Loop
If lngCount > 1 Then
lngCount = 1
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = arrTerms(lngIndex)
.MatchCase = False
Do While .Execute
If lngCount = 1 Then
oRng.InsertAfter " (" & arrAcr(lngIndex) & ")"
lngCount = lngCount + 1
Else
oRng.Text = "(" & arrAcr(lngIndex) & ")"
End If
oRng.Collapse wdCollapseEnd
Loop
End With
End If
End With
Next lngIndex
lbl_Exit:
Exit Sub
End Sub


27463

[Roberto_harg]

Hey Greg

Thank you!

Sorry about that, and thanks for the head start.

I'll try and evolve it and post back :-)

Rob


Roberto,

I poked you in the eye because this is not a code writing service. We are here to help YOU learn to write code. Not to write it for you. The concept is to teach you how to fish so you eat for a lifetime rather than give you a fish so you can eat today. However, this is your first post here and perhaps that was a bit harsh.

This is the sort of thing that you can do using arrays where you define what the "terms" are and what the associated acronyms are. With counters (to see if the term appears more than once) and with find and replace routines. Here is a fish.


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Dim arrTerms() As String
Dim arrAcr() As String
Dim lngIndex As Long, lngCount As Long
arrTerms = Split("alcohol,substance abuse disorders", ",")
arrAcr = Split("AD,SAD", ",")
For lngIndex = 0 To UBound(arrTerms)
Set oRng = ActiveDocument.Range
lngCount = 0
With oRng.Find
.Text = arrTerms(lngIndex)
.MatchCase = False
Do While .Execute
lngCount = lngCount + 1
If lngCount > 1 Then Exit Do
Loop
If lngCount > 1 Then
lngCount = 1
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = arrTerms(lngIndex)
.MatchCase = False
Do While .Execute
If lngCount = 1 Then
oRng.InsertAfter " (" & arrAcr(lngIndex) & ")"
lngCount = lngCount + 1
Else
oRng.Text = "(" & arrAcr(lngIndex) & ")"
End If
oRng.Collapse wdCollapseEnd
Loop
End With
End If
End With
Next lngIndex
lbl_Exit:
Exit Sub
End Sub


27463

[macropod]

See, for example: https://www.msofficeforums.com/word-vba/42313-acronym-definiton-list-generator.html

There are two macros in that thread. The:
• first looks for acronyms comprised of upper-case/numeric parenthetic abbreviations and looks for the preceding strings they represent. The output is sent to a table.
• second uses the table created by the first one (plus any definitions you care to add to the table), then goes through the document making sure the acronyms and their definitions are listed the first time they occur, then as acronyms only thereafter.

[gmaxey]

Paul,

Please see my post in the tread you mentioned above. If I'm wrong, I'll take my licks ;-)

[macropod]

I don't see one by you in that particular thread.

[gmaxey]

Paul,

It was. Anyway, I posted it again.

[macropod]

Yes, I see it now. You're probably right about needing to reset Rng on each iteration.