Seeking Optimization for Word Macro Execution Time
-
- NewLounger
- Posts: 6
- Joined: 12 Jan 2024, 02:14
Seeking Optimization for Word Macro Execution Time
Hi all! This is my first post in this forum. Nice to meet you all.
I am reaching out to discuss a Word macro I have been utilizing to highlight specific text based on an Excel file. While the macro is functional, I am looking for ways to enhance its performance and reduce the execution time.
Read the code here: https://drive.google.com/file/d/1xqBlXF ... sp=sharing
Applying the macro to a Word document spanning approximately 200 pages takes about one minute to complete the highlighting process. However, I am interested in exploring possibilities to compress this time frame to less than 50 seconds or even faster.
I understand all of you possess extensive expertise in Microsoft Word VBA macros and their optimization. Therefore, I would like to seek guidance in any optimizations that could improve execution.
Your insights and recommendations regarding this matter would be highly appreciated. Your expertise and knowledge will help me achieve the desired improvement in execution time. Please let me know if you require additional information or access to the existing code.
Thank you very much for your attention and support.
I am reaching out to discuss a Word macro I have been utilizing to highlight specific text based on an Excel file. While the macro is functional, I am looking for ways to enhance its performance and reduce the execution time.
Read the code here: https://drive.google.com/file/d/1xqBlXF ... sp=sharing
Applying the macro to a Word document spanning approximately 200 pages takes about one minute to complete the highlighting process. However, I am interested in exploring possibilities to compress this time frame to less than 50 seconds or even faster.
I understand all of you possess extensive expertise in Microsoft Word VBA macros and their optimization. Therefore, I would like to seek guidance in any optimizations that could improve execution.
Your insights and recommendations regarding this matter would be highly appreciated. Your expertise and knowledge will help me achieve the desired improvement in execution time. Please let me know if you require additional information or access to the existing code.
Thank you very much for your attention and support.
Last edited by vincent546 on 13 Jan 2024, 13:17, edited 1 time in total.
-
- Administrator
- Posts: 78671
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Seeking Optimization for Word Macro Execution Time
Welcome to Eileen's Lounge!
Any connection to yanlok1345?
You set MatchWildcards to True for ALL replacements if at least one row in column C contains T. Is that your intention?
Any connection to yanlok1345?
You set MatchWildcards to True for ALL replacements if at least one row in column C contains T. Is that your intention?
Best wishes,
Hans
Hans
-
- NewLounger
- Posts: 6
- Joined: 12 Jan 2024, 02:14
Re: Seeking Optimization for Word Macro Execution Time
I am yanlok's brother. Thank you for your prompt response. Yes. That's my intention.HansV wrote: ↑13 Jan 2024, 11:41Welcome to Eileen's Lounge!
Any connection to yanlok1345?
You set MatchWildcards to True for ALL replacements if at least one row in column C contains T. Is that your intention?
-
- Administrator
- Posts: 78671
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Seeking Optimization for Word Macro Execution Time
If nobody else replies, I'll get back to you later.
Best wishes,
Hans
Hans
-
- NewLounger
- Posts: 6
- Joined: 12 Jan 2024, 02:14
-
- Administrator
- Posts: 78671
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Seeking Optimization for Word Macro Execution Time
I don't see much that can be optimized. Try this version:
Code: Select all
Sub H()
Dim cellData As Variant
Dim maxCount, iCount As Long
Dim excelPath As String
Dim objExcel As Object
Dim objWb As Object
Dim F As Boolean
Dim VChar As Variant
excelPath = "E:\H.xlsx"
On Error Resume Next
Set objExcel = GetObject(Class:="Excel.Application")
If objExcel Is Nothing Then
Set objExcel = CreateObject(Class:="Excel.Application")
F = True
End If
Set objWb = objExcel.Workbooks.Open(FileName:=excelPath)
With objWb.Sheets(1)
maxCount = .Cells(.Rows.Count, 1).End(-4162).Row
VChar = .Range("A2:A" & maxCount).Value
If Not .Range("C2:C" & maxCount).Find(What:="T") Is Nothing Then
Selection.Find.MatchWildcards = True
End If
End With
objWb.Close SaveChanges:=False
If F Then
objExcel.Quit
End If
Application.ScreenUpdating = False
Options.DefaultHighlightColorIndex = wdYellow
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Replacement.Text = "^&"
.Wrap = wdFindStop
For iCount = 1 To maxCount - 1
If VChar(iCount, 1) <> "" Then
.Execute FindText:=VChar(iCount - 1), Replace:=wdReplaceAll
End If
Next iCount
End With
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- NewLounger
- Posts: 6
- Joined: 12 Jan 2024, 02:14
Re: Seeking Optimization for Word Macro Execution Time
I appreciate your assistance. Thank you once again for taking the time to help me.HansV wrote: ↑13 Jan 2024, 14:47I don't see much that can be optimized. Try this version:
Code: Select all
Sub H() Dim cellData As Variant Dim maxCount, iCount As Long Dim excelPath As String Dim objExcel As Object Dim objWb As Object Dim F As Boolean Dim VChar As Variant excelPath = "E:\H.xlsx" On Error Resume Next Set objExcel = GetObject(Class:="Excel.Application") If objExcel Is Nothing Then Set objExcel = CreateObject(Class:="Excel.Application") F = True End If Set objWb = objExcel.Workbooks.Open(FileName:=excelPath) With objWb.Sheets(1) maxCount = .Cells(.Rows.Count, 1).End(-4162).Row VChar = .Range("A2:A" & maxCount).Value If Not .Range("C2:C" & maxCount).Find(What:="T") Is Nothing Then Selection.Find.MatchWildcards = True End If End With objWb.Close SaveChanges:=False If F Then objExcel.Quit End If Application.ScreenUpdating = False Options.DefaultHighlightColorIndex = wdYellow Selection.HomeKey Unit:=wdStory With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Replacement.Highlight = True .Replacement.Text = "^&" .Wrap = wdFindStop For iCount = 1 To maxCount - 1 If VChar(iCount, 1) <> "" Then .Execute FindText:=VChar(iCount - 1), Replace:=wdReplaceAll End If Next iCount End With Application.ScreenUpdating = True End Sub
-
- Microsoft MVP
- Posts: 1320
- Joined: 24 May 2013, 15:33
- Location: Warminster, PA
Re: Seeking Optimization for Word Macro Execution Time
I'm not sure whether this will make the code any faster, but I don't have the setup to test it...
Manipulating Word's Selection object affects not just the screen display of the document (which is turned off by setting ScreenUpdating = False) but also its internal representation. Instead, you can use a Range object, which is not connected to any display code. It doesn't move the cursor or cause any scrolling, and doesn't trigger any pagination code.
If you want to try it, here's a modified version of Hans' code.
Manipulating Word's Selection object affects not just the screen display of the document (which is turned off by setting ScreenUpdating = False) but also its internal representation. Instead, you can use a Range object, which is not connected to any display code. It doesn't move the cursor or cause any scrolling, and doesn't trigger any pagination code.
If you want to try it, here's a modified version of Hans' code.
Code: Select all
Sub H()
Dim cellData As Variant
Dim maxCount As Long, iCount As Long ' without As Long, maxCount will be Variant
Dim oRng As Word.Range ' Word.Range is not like Excel.Range
Dim bUseWC As Boolean ' holder for MatchWildcards value
Dim excelPath As String
Dim objExcel As Object
Dim objWb As Object
Dim F As Boolean
Dim VChar As Variant
excelPath = "E:\H.xlsx"
On Error Resume Next
Set objExcel = GetObject(Class:="Excel.Application")
If objExcel Is Nothing Then
Set objExcel = CreateObject(Class:="Excel.Application")
F = True
End If
Set objWb = objExcel.Workbooks.Open(filename:=excelPath)
With objWb.Sheets(1)
maxCount = .Cells(.Rows.Count, 1).End(-4162).Row
VChar = .Range("A2:A" & maxCount).Value
If Not .Range("C2:C" & maxCount).Find(What:="T") Is Nothing Then
' Selection.Find.MatchWildcards = True
bUseWC = True ' defaults to False
End If
End With
objWb.Close SaveChanges:=False
If F Then
objExcel.Quit
End If
' Application.ScreenUpdating = False ' not needed for Range instead of Selection
Options.DefaultHighlightColorIndex = wdYellow
' Selection.HomeKey Unit:=wdStory
Set oRng = ActiveDocument.Range ' search whole document
With oRng.Find
' .ClearFormatting ' not needed for Range
' .Replacement.ClearFormatting
.MatchWildcards = bUseWC ' from worksheet
.Replacement.Highlight = True
.Replacement.Text = "^&"
.Wrap = wdFindStop
For iCount = 1 To maxCount - 1
If VChar(iCount, 1) <> "" Then
.Execute FindText:=VChar(iCount - 1), Replace:=wdReplaceAll
End If
Next iCount
End With
' Application.ScreenUpdating = True ' not needed for Range
End Sub
-
- 4StarLounger
- Posts: 596
- Joined: 14 Nov 2012, 16:06
Re: Seeking Optimization for Word Macro Execution Time
Try:
Code: Select all
Sub M_snb()
sn = GetObject("G:\OF\Reference.xlsx").sheets(1).usedrange
ActiveDocument.TrackRevisions = True
With ActiveDocument.Range.Find
For j = 1 To UBound(sn)
.Execute sn(j, 1), True, , , , , , , , sn(j, 2), 2
Next
End With
End Sub[/code)
-
- NewLounger
- Posts: 6
- Joined: 12 Jan 2024, 02:14
Re: Seeking Optimization for Word Macro Execution Time
Many thanks for your help. But it cannot highlight specific text based on an excel file.....anyway, i will further investigate the reasons. Thanks again for your help!Jay Freedman wrote: ↑13 Jan 2024, 19:14I'm not sure whether this will make the code any faster, but I don't have the setup to test it...
Manipulating Word's Selection object affects not just the screen display of the document (which is turned off by setting ScreenUpdating = False) but also its internal representation. Instead, you can use a Range object, which is not connected to any display code. It doesn't move the cursor or cause any scrolling, and doesn't trigger any pagination code.
If you want to try it, here's a modified version of Hans' code.
Code: Select all
Sub H() Dim cellData As Variant Dim maxCount As Long, iCount As Long ' without As Long, maxCount will be Variant Dim oRng As Word.Range ' Word.Range is not like Excel.Range Dim bUseWC As Boolean ' holder for MatchWildcards value Dim excelPath As String Dim objExcel As Object Dim objWb As Object Dim F As Boolean Dim VChar As Variant excelPath = "E:\H.xlsx" On Error Resume Next Set objExcel = GetObject(Class:="Excel.Application") If objExcel Is Nothing Then Set objExcel = CreateObject(Class:="Excel.Application") F = True End If Set objWb = objExcel.Workbooks.Open(filename:=excelPath) With objWb.Sheets(1) maxCount = .Cells(.Rows.Count, 1).End(-4162).Row VChar = .Range("A2:A" & maxCount).Value If Not .Range("C2:C" & maxCount).Find(What:="T") Is Nothing Then ' Selection.Find.MatchWildcards = True bUseWC = True ' defaults to False End If End With objWb.Close SaveChanges:=False If F Then objExcel.Quit End If ' Application.ScreenUpdating = False ' not needed for Range instead of Selection Options.DefaultHighlightColorIndex = wdYellow ' Selection.HomeKey Unit:=wdStory Set oRng = ActiveDocument.Range ' search whole document With oRng.Find ' .ClearFormatting ' not needed for Range ' .Replacement.ClearFormatting .MatchWildcards = bUseWC ' from worksheet .Replacement.Highlight = True .Replacement.Text = "^&" .Wrap = wdFindStop For iCount = 1 To maxCount - 1 If VChar(iCount, 1) <> "" Then .Execute FindText:=VChar(iCount - 1), Replace:=wdReplaceAll End If Next iCount End With ' Application.ScreenUpdating = True ' not needed for Range End Sub
-
- NewLounger
- Posts: 6
- Joined: 12 Jan 2024, 02:14
-
- 4StarLounger
- Posts: 596
- Joined: 14 Nov 2012, 16:06
Re: Seeking Optimization for Word Macro Execution Time
If you have any idea of working in VBA you should know.
-
- Administrator
- Posts: 78671
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Seeking Optimization for Word Macro Execution Time
snb's code is an ordinary macro, so it belongs in a standard module.
Best wishes,
Hans
Hans