Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-20-2021, 05:36 PM
Gontch Gontch is offline speed up macro to Highlight Phrases in document based on list input from text file Windows 10 speed up macro to Highlight Phrases in document based on list input from text file Office 2019
Novice
speed up macro to Highlight Phrases in document based on list input from text file
 
Join Date: Jan 2021
Posts: 2
Gontch is on a distinguished road
Default speed up macro to Highlight Phrases in document based on list input from text file

The goal here is to run a macro which will import a list of phrases and highlight them in the document. The text file has phrases separated by line like this :



Miles per Hour
Carbon Dioxide
Supply Fan
ect…

My macro highlights the first occurrence yellow and and following occurrences pink. I also have another list for the acronym which goes with the phrase. So the first occurrence of Miles per Hour and first occurrence of (MPH) will be yellow. I want to replace all the pink phrases with appropriate acronyms as they should be defined now. I have a working macro, but it's ugly and takes forever.

Any advice to cut down the looping process here? It's basically the 3 of the same macros...

Code:
Sub QC_Time()

Call HighlightExtraPhrases
Call HighlightPhrases
Call HighlightAcroynms

End Sub


Sub HighlightPhrases()

Application.ScreenUpdating = False
Options.DefaultHighlightColorIndex = wdYellow
Dim MyString As String
Dim MyAcroFileName As String
Dim rng As Range

    MyAcroFileName = "C:\Users\gontch\Desktop\Phrase Running List.txt"
Open MyAcroFileName For Input As #1

'loop through the file until the end of file marker is reached

Do While Not EOF(1)
    'read line of text, place it in the MyString variable
    Line Input #1, MyString
    'Reset the Range object to the entire current document
    Set rng = ActiveDocument.Range
    rng.Find.Replacement.Highlight = True
    With rng.Find
        .Text = MyString
        .Replacement.Text = MyString
        .MatchCase = False
        .MatchWholeWord = True
        .Execute Replace:=wdReplaceOne
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Highlight = True
            End With
Loop

'close the text file
Close #1
Application.ScreenUpdating = True

End Sub
Sub HighlightExtraPhrases()

Application.ScreenUpdating = False
Options.DefaultHighlightColorIndex = wdPink
Dim MyString As String
Dim MyAcroFileName As String
Dim rng As Range

    MyAcroFileName = "C:\Users\gontch\Desktop\Phrase Running List.txt"
Open MyAcroFileName For Input As #1

'loop through the file until the end of file marker is reached

Do While Not EOF(1)
    'read line of text, place it in the MyString variable
    Line Input #1, MyString
    'Reset the Range object to the entire current document
    Set rng = ActiveDocument.Range
    rng.Find.Replacement.Highlight = True
    With rng.Find
        .Text = MyString
        .Replacement.Text = MyString
        .MatchCase = False
        .MatchWholeWord = True
        .Execute Replace:=wdReplaceAll
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Highlight = True
            End With
Loop

'close the text file
Close #1
Application.ScreenUpdating = True

End Sub

Sub HighlightAcroynms()

Application.ScreenUpdating = False
Options.DefaultHighlightColorIndex = wdYellow
Dim MyString As String
Dim MyAcroFileName As String
Dim rng As Range

    MyAcroFileName = "C:\Users\gontch\Desktop\Acronyms Running List.txt"
Open MyAcroFileName For Input As #1

'loop through the file until the end of file marker is reached

Do While Not EOF(1)
    'read line of text, place it in the MyString variable
    Line Input #1, MyString
    'Reset the Range object to the entire current document
    Set rng = ActiveDocument.Range
    rng.Find.Replacement.Highlight = True
    With rng.Find
        .Text = MyString
        .Replacement.Text = MyString
        .MatchCase = True
        .MatchWholeWord = True
        .Execute Replace:=wdReplaceOne
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Highlight = True
    End With
Loop

'close the text file
Close #1
Application.ScreenUpdating = True

End Sub
Reply With Quote
  #2  
Old 01-20-2021, 09:25 PM
Guessed's Avatar
Guessed Guessed is offline speed up macro to Highlight Phrases in document based on list input from text file Windows 10 speed up macro to Highlight Phrases in document based on list input from text file Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

The two phrase macros could be simplified since they are reading the same source file. This would speed up your execution time by a considerable amount.

Then you can also reduce the total amount of code by making the macro into a function (or sub) with inputs. Note that this reduces the amount of code you have to maintain but won't be faster to execute.
Code:
Sub QC_Time()
  HighlightPhrases MyAcroFileName:="C:\Users\gontch\Desktop\Phrase Running List.txt", bAll:=True
  HighlightPhrases MyAcroFileName:="C:\Users\gontch\Desktop\Acronyms Running List.txt", bAll:=False
End Sub

Function HighlightPhrases(MyAcroFileName As String, bAll As Boolean)
  Dim MyString As String, rng As Range

  Application.ScreenUpdating = False
    Open MyAcroFileName For Input As #1
      Do While Not EOF(1)                 'loop through the file until the end of file marker is reached
        Line Input #1, MyString           'read line of text, place it in the MyString variable
        Set rng = ActiveDocument.Range    'Reset the Range object to the entire current document
        With rng.Find
          .Text = MyString
          .Replacement.Text = MyString
          .MatchCase = False
          .MatchWholeWord = True
          .Forward = True
          .Replacement.Highlight = True
          If bAll Then
            Options.DefaultHighlightColorIndex = wdPink
            .Execute Replace:=wdReplaceAll
          End If
          Options.DefaultHighlightColorIndex = wdYellow
          .Execute Replace:=wdReplaceOne
         End With
      Loop
    Close #1          'close the text file
  Application.ScreenUpdating = True
End Function
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #3  
Old 01-21-2021, 11:08 AM
Gontch Gontch is offline speed up macro to Highlight Phrases in document based on list input from text file Windows 10 speed up macro to Highlight Phrases in document based on list input from text file Office 2019
Novice
speed up macro to Highlight Phrases in document based on list input from text file
 
Join Date: Jan 2021
Posts: 2
Gontch is on a distinguished road
Default

Excellent work Guessed! Your code looks much cleaner and easier to manipulate. Run-time has been cut down significantly as well from 7 min to 3 min. I was particularly impressed with the simple Boolean function assignment for the inputs.

Looks like I need to cut down on my phrases/acronyms to speed things up. There are hundreds already and most are rarely used.

Thank you very much.
Reply With Quote
Reply

Tags
acronym, highlight, replace

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
speed up macro to Highlight Phrases in document based on list input from text file Speed up macro that calls Excel-based function Peterson Word VBA 2 08-11-2020 06:18 AM
speed up macro to Highlight Phrases in document based on list input from text file Macro To Identify & Highlight Words In MS Word Based Upon A List In Excel File Column abhimanyu Word VBA 5 03-20-2020 01:33 PM
Macro to highlight duplicate phrases in document? taw Word VBA 0 02-27-2018 01:47 PM
speed up macro to Highlight Phrases in document based on list input from text file Inserting text from one word file into another based on an excel input jmaxcy Excel 14 11-01-2013 04:07 PM
Inserting text from one word file into another based on an excel input jmaxcy Word 3 11-01-2013 01:26 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 08:02 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft