Why does the document get selected after undo-ing my script?
I have written a vba script that finds endnotes with duplicate reference text, and shades them to the same color, and shows a MsgBox report.
The plan is an editor would read this MsgBox/Report and scan the highlighted duplicates, then Undo the script and make their edits.
Everything is working well EXCEPT the Undo will leave the entire document selected, even though I'm not making any selections in my code (that I'm aware of).
Please see the attached image where I show the 3 states, Before, After running my script, and finally after the Undo.
I'm also posting the sample docx file and my code below. Please know that as will be obvious in my code, that I'm new to VBA and have a lot to learn.
I have noticed this problem with undo selecting the document in my other scripts as well, so not sure what I'm doing wrong.
Code:
Sub bhh_duplicateCheck()
' Checks for duplicate endnotes, shades duplicates with the same color, and shows a report.
' Written by Brian Hoard, www.BrianHoard.com
' Script date: 09/05/2022
' 09/07/2022
' Updates for v0.4
' Found the problem where undo would not return endnote reference text to it's normal state was in the order
' shading was being done. Fixed this so undo works properly.
' 09/09/2022
' Updates for v0.5
' Expanding body selection to include the work preceding marker text.
' Working to avoid selecting the document after undo.
' Declare vars
Dim scriptName, str_prompt, str_lower1, str_summary, enRefText, str_dupeRefText, str_reportOpening, str_reportBody As String
' Object
' .net arrays
Dim colorGroups_LL As Variant ' This is an array of arrays, so must be a variant type.
Dim enDupes_LL, enNumbersUnique_L, enRefTextUnique_L, eNotes_LL, enRefInsensitive_L, colors_L, completed_L, colorGroup_L As Object
Dim eNotes As Endnotes
Dim eNote As Endnote
' Integer
Dim dupeCounter, i, int_master, int_dupe, eNumber, int_endnotesOrig, int_colorCounter, loopCounter, int_enDupesCount As Integer
' For each temp vars (must be object or variant)
Dim enI, dupe, c, m, v, row, messageBox, colorGroup, arr_colorGroup As Variant
' Range
Dim rng_source, rng_shading As Range
' Long
Dim lng_rngEnd, lng_highlight As Long
scriptName = "bhh_duplicateCheck v0.5"
Set eNotes = ActiveDocument.Endnotes
' Get number of endnotes in document. Show a msgBox if none exist, and exit.
' We'll also use this number for the end report for how many we started with.
int_endnotesOrig = eNotes.Count
If int_endnotesOrig = 0 Then
' No endnotes, show msgBox and exit.
str_prompt = "This script checks for duplicate dynamic endnotes." & _
vbCr & "There are no dynamic endnotes in this document."
Call MsgBox(Prompt:=str_prompt, Buttons:=vbInformation, Title:=scriptName)
Exit Sub
End If ' int_endnotesOrig 0
' Create .net arrays.
Set eNotes_LL = CreateObject("System.Collections.ArrayList") ' Stores ALL endnotes
Set enDupes_LL = CreateObject("System.Collections.ArrayList") ' Holds duplicate info with both master and duplicate endnote number.
' Using 3 synchronized arrays. One for endnote number, 2nd for enRefText, 3rd for lowercase, insensitive
' version of enRefText. This allows tracking unique endnotes without the complexity of a list of lists.
' Keep these 3 arrays in sync by adding new data to them together. This method was chose to allow "is in"
' command to check if a text is in an array without needing to do multiple for loops.
Set enNumbersUnique_L = CreateObject("System.Collections.ArrayList") ' holds unique endnote numbers
Set enRefTextUnique_L = CreateObject("System.Collections.ArrayList") ' holds unique reference text
Set enRefInsensitive_L = CreateObject("System.Collections.ArrayList") ' holds unique reference text, lowercase, whitespace and periods removed.
Set colors_L = CreateObject("System.Collections.ArrayList") ' Holds the fixed RGB values for shading.
Set completed_L = CreateObject("System.Collections.ArrayList") ' Holds master numbers that have been processed.
Set colorGroup_L = CreateObject("System.Collections.ArrayList") ' Holds the master and all of it's dupes that will be shaded the same color.
Set colorGroups_LL = CreateObject("System.Collections.ArrayList") ' Array of Arrays, holding the colorGroup_L sub-array with master/dupes groups.
eNumber = 1 ' Declare starting endnote number
For Each eNote In eNotes ' This loop finds and stores duplicates if there are any.
Set rng_source = eNote.Range ' Init range as endnote range.
With rng_source
lng_rngEnd = .End ' Store full range endpoint.
.Expand Unit:=wdParagraph ' Expands start and end to the first paragraph in endnote, to include text before citation number.
' But this also moves the end to the first paragraph, so let's move the end back to where it started.
.End = lng_rngEnd ' ensures multiple paragraphs in reference text are preserved.
End With 'rng_source
' Store original ref text, including text before citation number.
enRefText = rng_source.Text
' Append each endnote info to eNotes_LL
eNotes_LL.Add Array(eNumber, enRefText)
' Create modified version of enRefText to allow comparing as lowercase, without whitespace, special STX character, commas, or periods.
' We'll do this in multiple steps, continuing to modify str_lower1
str_lower1 = LCase(enRefText) ' Store enRefText as lowercase
str_lower1 = Replace(str_lower1, " ", "") ' Remove all spaces
str_lower1 = Replace(str_lower1, vbTab, "") ' Remove all tabs
str_lower1 = Replace(str_lower1, Chr(2), "") ' Remove special STX character
str_lower1 = Replace(str_lower1, ".", "") ' Remove all periods
str_lower1 = Replace(str_lower1, ",", "") 'Remove all commas
' Check if str_lower1 is already in enRefInsensitive_L. If not, append the current endnote info to the unique array trio.
' CAUTION: The following area contains an Exit For break within a nested If statement. It's very confusing in code.
' A little easier to follow in the Corel flow, so tread with caution.
If Not enRefInsensitive_L.Contains(str_lower1) Then
enRefInsensitive_L.Add (str_lower1) ' Array holding insensitive, lowercase string
enNumbersUnique_L.Add (eNumber) ' Array holding unique endnote numbers.
enRefTextUnique_L.Add (enRefText) ' Array holding unique reference text
' NOTE: The above arrays must always stay in sync.
Else
' If we're here, we know we have a dupe, but which endnote was there first, as that is the Master.
' NOTE: Endnotes are 1-indexed, but array IDs are 0-indexed, so be careful then.
dupeCounter = 0 ' Here, we're using 0-indexed array index numbers to get info from the array trio.
For Each enI In enRefInsensitive_L ' For each dupe, we loop through enRefInsensitive_L, finding which index/citation number was already stored.
If enI = str_lower1 Then
' The current enNumbersUnique_L(dupeCounter) is Master, already in array trio.
int_master = enNumbersUnique_L(dupeCounter) ' Store info to append to array trio.
enDupes_LL.Add Array(int_master, eNumber, enRefText) ' Append dupe info to enDupes_LL
' We found the master ID for this dupe, so break the parent for loop.
Exit For 'enI In enRefInsensitive_L
Else ' The current ID is NOT the dupe then. Increment dupeCounter to check next one.
dupeCounter = dupeCounter + 1
End If ' enI = str_lower1
Next enI ' In enRefInsensitive_L
End If ' not enRefInsensitive_L.contains(str_lower1)
eNumber = eNumber + 1 ' Increment parent For Each loop endnote number
Next eNote
' At this point, we know how many dupes we have, so check if it's > 0, or show a message that there are no dupes.
int_enDupesCount = enDupes_LL.Count ' Storing as var so we don't have to calculate it more than once.
If int_enDupesCount = 0 Then
' Store msgBox vars
str_prompt = "No duplicate endnotes were found."
Call MsgBox(Prompt:=str_prompt, Buttons:=vbInformation, Title:=scriptName)
' Housekeeping before exiting
StatusBar = (scriptName & " complete")
' System.Cursor = wdCursorNormal
Debug.Print (scriptName & ", " & Now())
Exit Sub
End If ' enDupes.Count = 0
' If we're here, we have dupes
' ----- Starting boilerplate
' Begin undo record
Dim bhhUndo As UndoRecord
Set bhhUndo = Application.UndoRecord
bhhUndo.StartCustomRecord (scriptName)
Application.ScreenUpdating = False
' Ensure endnotes are using numeric ref numbers.
ActiveDocument.Range.EndnoteOptions.NumberStyle = wdNoteNumberStyleArabic
' Set status bar text, and turn cursor to wait.
StatusBar = ("Please wait for " & scriptName & "...")
' System.Cursor = wdCursorWait ' Doesn't really work, but it's all we have.
' With some endnotes verified in the document, begin script.
' ----- Starting boilerplate
Debug.Print ("Starting " & scriptName & ", " & Now() & vbCr & "--------------------")
' Prepare the array of fixed colors.
Set colors_L = CreateObject("System.Collections.ArrayList") ' Declare .net array
colors_L.Add RGB(255, 113, 113)
colors_L.Add RGB(198, 255, 113)
colors_L.Add RGB(237, 181, 255)
colors_L.Add RGB(255, 214, 113)
colors_L.Add RGB(113, 198, 255)
colors_L.Add RGB(255, 198, 57)
colors_L.Add RGB(170, 171, 255)
colors_L.Add RGB(255, 252, 117)
colors_L.Add RGB(255, 123, 169)
colors_L.Add RGB(97, 255, 162)
colors_L.Add RGB(112, 255, 77)
colors_L.Add RGB(255, 129, 227)
colors_L.Add RGB(117, 153, 255)
colors_L.Add RGB(255, 229, 0)
colors_L.Add RGB(50, 240, 240)
' Loop through enDupes_LL, storing dupes with the same master into an array of arrays
loopCounter = 0
For Each row In enDupes_LL ' int_master(0), int_dupe(1), str_dupeRefText(2)
colorGroup_L.Clear ' Reset each iteration as we'll only be storing the current master and it's dupes each time.
int_master = row(0)
int_dupe = row(1)
str_dupeRefText = row(2)
' Store current dupe info for end report.
str_summary = Left(str_dupeRefText, 40) ' Stores first (n) characters of string row(2).
str_summary = Replace(str_summary, Chr(2), "") ' Replace special STX character with nothing.
str_summary = Replace(str_summary, vbCr, " ") ' Replace carriage returns with space for the report.
str_reportBody = (str_reportBody & vbCr & int_dupe & " is a duplicate of " & int_master & ". " & str_summary)
' If we've already processed this master, skip it.
If not completed_L.Contains(int_master) Then
' Not in completed_L, needs processing
' Not completed, so process it.
completed_L.Add (int_master) ' Add int_master to completed_L so it isn't processed again.
' Populate colorGroup_L with all duplicate endnotes sharing the same master
colorGroup_L.Add (int_master) ' Add the master
colorGroup_L.Add (int_dupe) ' Add the dupe
' If we're NOT on the last item in enDupes_LL, Loop through enDupes_LL again, but starting
' at the next row forward, adding additional dupes with the current master.
If loopCounter < int_enDupesCount Then
' We're not on the last item, so search forward for more masters
' Loop through the array we're looping through, starting with the current row + 1,
' looking for any more masters = to the current master.
' If we find any, append just their dupe to colorGroup_L.
For i = (loopCounter + 1) To (int_enDupesCount - 1) ' Looping through enDupes_LL again within the parent loop.
' But only starting at the next row, forward.
' Looping until .Count - 1 since array is 0-indexed).
If enDupes_LL(i)(0) = int_master Then ' Is this master the same as our current int_master?
colorGroup_L.Add (enDupes_LL(i)(1)) ' We found another dupe with the same master, so add just the dupe to colorGroup_L.
End If ' enDupes_LL(i)(0) = int_master
Next 'i
End If ' loopCounter < int_endnotesOrig
' Okay, we have all dupes stored for the current master, add the current colorGroup_L array to colorGroups_LL.
' OLD: colorGroups_LL.Add colorGroup_L
' The above caused a problem where the values were linked to their original vars.
' So what gets added to the array is only the most recent values stored, overwriting the previous ones.
' The following copies our .net array to a vba array where the values don't change.
arr_colorGroup = colorGroup_L.ToArray ' Copy colorGroup_L to regular vba array
' Now, let's add this to the array of arrays.
colorGroups_LL.Add arr_colorGroup
End If ' not completed_L.contains(int_master)
loopCounter = loopCounter + 1
Next row ' in enDupes_LL
' Okay, we have all master/dupe groups stored as arrays within
' the colorGroups_LL array. Get to shading them from colors_L
int_colorCounter = 0 ' Init at 0. This is the var that holds which fixed color we're on.
' Loop through the array of arrays
For Each colorGroup In colorGroups_LL
lng_highlight = colors_L(int_colorCounter) ' Stores shading color for this group.
' Loop through the sub-array shading each marker and endnote text.
For Each c In colorGroup
Set rng_shading = eNotes(c).Range ' Init range as endnote range.
lng_rngEnd = rng_shading.End
with rng_shading
.Expand Unit:=wdParagraph ' Expands start and end to the first paragraph, including text before citation number.
.End = lng_rngEnd ' Put the range end back to where it was, recovering multiple paragraphs if they exist.
end with ' rng_shading
' IMPORTANT The following shading must be in this order or else undo fails to undo the endnote reference text shading.
eNotes(c).Reference.Font.Shading.BackgroundPatternColor = lng_highlight ' Shade marker text
rng_shading.Font.Shading.BackgroundPatternColor = lng_highlight ' Highlight text
Next c ' in colorGroup
' Check if int_colorCounter is on the last one. If so, reset it back to 0 and start over, repeating the colors.
' Otherwise, increment by 1
If int_colorCounter = (colors_L.Count - 1) Then
int_colorCounter = 0 ' reset to beginning
Else
int_colorCounter = int_colorCounter + 1
End If ' int_colorCounter ...
Next colorGroup ' in colorGroups_LL
' Okay, all of our masters and dupes are shaded.
' Next, build the report MsgBox using strings built earlier.
str_reportOpening = ("Duplicate endnotes: " & enDupes_LL.Count & vbCr & "Total endnotes: " & int_endnotesOrig)
str_prompt = (str_reportOpening & vbCr & str_reportBody)
' Do the final things before displaying MsgBox, so that all of our printing, and document edits are completed,
' in case the MsgBox is on the screen for a while. We don't want it to affect our script timing.
Debug.Print (scriptName & " completed, " & Now())
' ----- Ending boilerplate
StatusBar = (scriptName & " complete.")
' System.Cursor = wdCursorNormal
Application.ScreenUpdating = True
Application.ScreenRefresh ' Ensures colors change in doc before showing MsgBox
' End undo
bhhUndo.EndCustomRecord
' All is done, show msgBox report.
messageBox = MsgBox(Prompt:=str_prompt, Buttons:=vbInformation, Title:=scriptName)
Exit Sub ' Ensure script exits
End Sub ' bhh_duplicateCheck v0.5
|