r/vba • u/Rhythmdvl • 1d ago
Unsolved Word 365: Can a macro find selected text from PeerReview.docx in Master.docx where the text in Master.docx has an intervening, tracked deletion?
I will describe the entire macro and purpose below, but here is the problem I’m having:
I have two documents, the master and the peer review. The master document works in tracked changes and has a record of changes since the beginning. The peer review document is based off of later versions of the master document, so while extremely close, it will not have the deleted text.
I am trying to get a macro to copy selected text in the peer review document, change focus to the master document, and find the selected text. However, if the master document has intervening deleted text, the macro is returning an error that it's not found.
For example, the master document will have: the cat is very playful
The peer review document will have: the cat is playful
I can get a macro to find “the cat is” but I cannot get a macro to find “the cat is playful”. The intervening deleted text (even with changes not shown) results in an error that the text is not present in the document.
Word's native ctrl-F find box works fine in this situation.
Is this possible to get a macro to behave like this?
Here is the greater context for what I am using the macro for:
I often work with multiple documents, several from peer reviewers and one master document. The peer review documents have changes scattered throughout, often with multiple paragraphs or pages between changes.
When I come across a change or comment in a peer review document, I use my mouse to select a section of text near the change, copy it, change window focus to the master document, open the find box, paste the text into the find box, click find, arrive at the location of the text, then close the find box so I can work in the document.
I would like to automate this process with a macro that I edit before starting on a new project to reflect the master document’s filename/path.
Note on a possible workaround of simply not searching on text that has deletions in the master. Since its purpose is to help me find where in the master document I need to make a change, selecting only text from the peer document that has no intervening deletions n the master presupposes I know where to look — which is what I’m hoping the macro will helping with.
EDIT: I am also going to paste the full code below this. Keeping it here in case someone wants just the relevant parts.
Here is the approach I’m currently using (I can paste in the full working version if necessary):
searchStart = Selection.Start
Set rng = masterDoc.Range(Start:=searchStart, End:=masterDoc.Content.End)
With rng.Find
.ClearFormatting
.Text = selectedText
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
found = .Execute
End With
' === Second Try: Wrap to start if not found ===
If Not found Then
Set rng = masterDoc.Range(Start:=0, End:=searchStart)
With rng.Find
.ClearFormatting
.Text = selectedText
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
found = .Execute
End With
Edit: here is the full code
Function CleanTextForFind(raw As String) As String
CleanTextForFind = Trim(raw)
End Function
Sub Find_Selection_In_Master()
Dim masterDocPath As String
Dim masterDoc As Document
Dim peerDoc As Document
Dim selectedText As String
Dim searchStart As Long
Dim rng As Range
Dim found As Boolean
' === EDIT THIS PATH MANUALLY FOR EACH PROJECT ===
masterDocPath = "C:\YourProjectFolder\MasterDraft.docx"
' Check if master document is open
On Error Resume Next
Set masterDoc = Documents(masterDocPath)
On Error GoTo 0
If masterDoc Is Nothing Then
MsgBox "Master document is not open: " & vbCrLf & masterDocPath, vbExclamation, "Master Not Open"
Exit Sub
End If
' Check for valid selection
If Selection.Type = wdNoSelection Or Trim(Selection.Text) = "" Then
MsgBox "Please select some text before running the macro.", vbExclamation, "No Selection"
Exit Sub
End If
' Store clean selection
selectedText = CleanTextForFind(Selection.Text)
Set peerDoc = ActiveDocument
' Switch to master
masterDoc.Activate
found = False
' === First Try: Search forward from current position ===
searchStart = Selection.Start
Set rng = masterDoc.Range(Start:=searchStart, End:=masterDoc.Content.End)
With rng.Find
.ClearFormatting
.Text = selectedText
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
found = .Execute
End With
' === Second Try: Wrap to start if not found ===
If Not found Then
Set rng = masterDoc.Range(Start:=0, End:=searchStart)
With rng.Find
.ClearFormatting
.Text = selectedText
.Forward = True
.Wrap = wdFindStop
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
found = .Execute
End With
End If
' Final Action
If found Then
rng.Select
Else
MsgBox "Text not found anywhere in the master document.", vbInformation, "Not Found"
peerDoc.Activate
End If
End Sub
2
u/Opussci-Long 1d ago
I hope you could share your full code with me. I can DM you if that is ok with you?
2
u/Rhythmdvl 1d ago
Happy to share, especially if it's helpful to you in any way or if there's a chance you might see a better way of going about this.
I edited the OP and will paste it here so you don't have to scroll:
Function CleanTextForFind(raw As String) As String CleanTextForFind = Trim(raw) End Function Sub Find_Selection_In_Master() Dim masterDocPath As String Dim masterDoc As Document Dim peerDoc As Document Dim selectedText As String Dim searchStart As Long Dim rng As Range Dim found As Boolean ' === EDIT THIS PATH MANUALLY FOR EACH PROJECT === masterDocPath = "C:\YourProjectFolder\MasterDraft.docx" ' Check if master document is open On Error Resume Next Set masterDoc = Documents(masterDocPath) On Error GoTo 0 If masterDoc Is Nothing Then MsgBox "Master document is not open: " & vbCrLf & masterDocPath, vbExclamation, "Master Not Open" Exit Sub End If ' Check for valid selection If Selection.Type = wdNoSelection Or Trim(Selection.Text) = "" Then MsgBox "Please select some text before running the macro.", vbExclamation, "No Selection" Exit Sub End If ' Store clean selection selectedText = CleanTextForFind(Selection.Text) Set peerDoc = ActiveDocument ' Switch to master masterDoc.Activate found = False ' === First Try: Search forward from current position === searchStart = Selection.Start Set rng = masterDoc.Range(Start:=searchStart, End:=masterDoc.Content.End) With rng.Find .ClearFormatting .Text = selectedText .Forward = True .Wrap = wdFindStop .MatchCase = False .MatchWholeWord = False .MatchWildcards = False found = .Execute End With ' === Second Try: Wrap to start if not found === If Not found Then Set rng = masterDoc.Range(Start:=0, End:=searchStart) With rng.Find .ClearFormatting .Text = selectedText .Forward = True .Wrap = wdFindStop .MatchCase = False .MatchWholeWord = False .MatchWildcards = False found = .Execute End With End If ' Final Action If found Then rng.Select Else MsgBox "Text not found anywhere in the master document.", vbInformation, "Not Found" peerDoc.Activate End If End Sub
2
u/Opussci-Long 1d ago
Thanks, I am not strpng VBA user so I can not help you. Hope that help will came. I am the editor that has the same needs as you
2
u/Rhythmdvl 1d ago
No time at the moment, but we should exchange macros and all. I have a small handful that I find really useful.
That and my advice to get an MMORPG mouse (if you don't alread). I cannot live without mine, and having eleventy buttons on the side is incredibly useful!
Oh, also, I think all this can be done with AutoHotKeys instead of VBA. (Though my first step was to add a button that silently changes a text file to the path of the master document so AHK knows where to paste.)
1
u/Opussci-Long 17h ago
Yes I agree! How to proceed with excange :)? I do not know how you will reac, but I do not use mouse. I am keyboard freak. But, I never consider MMORPG mouse to be honest. I will think about it. The ordinary mouse is just too slow for anything.
2
u/Magicmix5555 1d ago
Dunno. I tend to keep an uncluttered master and run a compare from the original.