Consulting

Results 1 to 10 of 10

Thread: Highlighting when two consecutive words are found more than once

  1. #1

    Highlighting when two consecutive words are found more than once

    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

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,244
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    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

  4. #4
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,244
    Location
    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
    Text.jpg
    Greg

    Visit my website: http://gregmaxey.com

  5. #5
    Hey Greg

    Thank you!

    Sorry about that, and thanks for the head start.

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

    Rob

    Quote Originally Posted by gmaxey View Post
    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
    Text.jpg

  6. #6
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,174
    Location
    See, for example: https://www.msofficeforums.com/word-...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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  7. #7
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,244
    Location
    Paul,

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

    Visit my website: http://gregmaxey.com

  8. #8
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,174
    Location
    I don't see one by you in that particular thread.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  9. #9
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,244
    Location
    Paul,

    It was. Anyway, I posted it again.
    Greg

    Visit my website: http://gregmaxey.com

  10. #10
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,174
    Location
    Yes, I see it now. You're probably right about needing to reset Rng on each iteration.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •