Macro to accept deleted insertions

EZRider · #1 06-08-2012, 07:03 AM

I have several word documents where multiple users were working on edits with track changes on. The issue that I'm having is that when a user deletes the insertions of another user, rather than removing all traces of the insertion it leaves the insertion and shows it as "strikethrough".

For an outsider reviewing the document it appears that the insertion was original text that we chose to delete.

Is there a macro that would go through the document and accept all changes that meet this criteria (inserted from one user then deleted from another)?

macropod · #2 06-11-2012, 05:09 AM

AFAIK, that's not possible.

When a reviewer replaces someone else's outstanding revision with their own (eg by overtyping a deletion or deleting an addition), Word only tracks the last action - it keeps no record of the previous outstanding revision.

EZRider · #3 06-12-2012, 08:37 AM

Thanks Macropod but Word will, with track changes on, keep a record of both changes.

I did manage to solve the issue I was having. If anyone is interested here is the code:

Code:

Sub StrikethroughDeletions() 
     'Turn off Track Changes
    ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions 
     'Highlight revisions of type deletion
    Number = ActiveDocument.Revisions.Count 
    For x = 1 To Number 
        Set myRev = ActiveDocument.Revisions(x).Range 
        This = ActiveDocument.Revisions(x).Type 
        If This = 2 Then 
            myRev.HighlightColorIndex = wdYellow 
        End If 
    Next x 
     ' For all highlighted text, underline and strikethrough if also inserted
    For Y = 1 To Number 
        Set myRev = ActiveDocument.Revisions(Y).Range 
        That = ActiveDocument.Revisions(Y).Type 
        If That = 1 Then 
            myRev.Select 
            If Selection.Range.HighlightColorIndex = wdYellow Then 
                Selection.Font.Underline = True 
                Selection.Font.StrikeThrough = True 
            End If 
        End If 
    Next Y 
     'This will then find and remove the deleted insertions
    Selection.Find.ClearFormatting 
    With Selection.Find.Font 
        .Underline = wdUnderlineSingle 
        .StrikeThrough = True 
        .DoubleStrikeThrough = False 
    End With 
    With Selection.Find 
        .Text = "" 
        .Replacement.Text = "" 
        .Forward = True 
        .Wrap = wdFindContinue 
        .Format = True 
        .MatchCase = False 
        .MatchWholeWord = False 
        .MatchWildcards = False 
        .MatchSoundsLike = False 
        .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
     
     'This will now delete all highlighting
    Dim rngDoc As Range 
    Set rngDoc = ActiveDocument.Range(Start:=0, End:=0) 
    With rngDoc.Find 
        .ClearFormatting 
        .Highlight = True 
        With .Replacement 
            .ClearFormatting 
            .Highlight = False 
        End With 
        .Execute Replace:=wdReplaceAll, Forward:=True, FindText:="", _ 
        ReplaceWith:="", Format:=True 
    End With 
     
     'Turn on track changes
    ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions 
End Sub

Thanks all

Alphacsulb · #4 08-19-2013, 03:40 PM

Thank you for posting that code, I was able to use part of it for my work flow.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Accept all changes then resave	cure4glass	Word VBA	1	03-08-2012 10:04 PM
accept grammar errors	Newbe1	Word	3	12-23-2010 03:05 PM
How to Set Password to Accept Changes	kurobenko	Word	1	05-12-2010 02:54 AM
MS Word 2007 - Product Key Not Accept	Ramesh	Office	0	02-18-2010 02:14 PM
Unable to Accept / Decline Appointments Sent to Me - HELP!	FrUtopia27	Outlook	0	04-16-2007 03:24 PM