Macro to accept deleted insertions - Help

[EZRider]

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]

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]

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:

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]

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