A better ‘anonymize a Word document’ solution


Office for Mere Mortals
Your beginners guide to the secrets of Microsoft Office
Invalid email address
Tips and help for Word, Excel, PowerPoint and Outlook from Microsoft Office experts.  Give it a try. You can unsubscribe at any time.  Office for Mere Mortals has been running for over 20 years, we've never, ever revealed or sold subscriber details.  Privacy policy

Here’s some better VBA code for converting a private document (contract etc) into one with anonymous words.  A useful trick if you’re trying to fix a Word formatting problem but can’t share the document.  Legal numbering problems is a common issue that this macro can help with.

Office-Watch.com has already done a macro which replaces each letter with a random letter.  And a manual way to replace with filler words of the same length.

The new version replaces each word with another of the same length, replaces all digits with 9 and highlights the changes.  Here’s a document before and after.

a better anonymize a word document solution microsoft word 17865 - A better 'anonymize a Word document' solution

All the changes are highlighted so you can quickly see what has been changed and anything which has been missed.  Word’s standard Find/Replace doesn’t ‘see’ everything in a document with Header, Footer and Text Boxes missed.  The highlighting helps you see any omissions.

Remove the highlighting, for easier viewing.  Select All (Ctrl + A) then choose No Color from the highlighting list.

a better anonymize a word document solution microsoft word 17867 - A better 'anonymize a Word document' solution

VBA code

The VBA code is below.  As usual, we’ve deliberately made the code easy to understand as opposed to clever <g>.

Thanks to Rose and Lillie for their suggestions ….

More than one solution

There’s more than one way to handle this problem.  As we type this, a reader has sent some code which handles capitalization and extended characters.  More on that soon.

To replace all text including Headers, Footers, Text Boxes etc is surprisingly and ridiculously complicated.  Have a look at this Word MVP page ‘Step 3’.

 

Sub ReplaceWordswithFillerRegex()

'

' Separate Replace Regex commands to substitute words for filler words of the same length

' for word lengths from 1 to 20.

' from Office-Watch.com

'

    Dim FillerWord As String

    Dim i As Integer

   

    For i = 1 To 20 ' up to 20 letter words

   

    Select Case i  ' replacement words  FillerWord

       

       Case 1

          FillerWord = "a"

       Case 2

          FillerWord = "be"

       Case 3

          FillerWord = "sea"

       Case 4

          FillerWord = "dead"

       Case 5

          FillerWord = "ether"

       Case 6

          FillerWord = "fights"

       Case 7

          FillerWord = "generic"

       Case 8

          FillerWord = "heavenly"

       Case 9

          FillerWord = "indicator"

       Case 10

          FillerWord = "janitorial"

       Case 11

          FillerWord = "labyrinthian"

       Case 12

          FillerWord = "manifestation"

       Case 13

          FillerWord = "neighborliness"

       Case 14

          FillerWord = "oceanographical"

       Case 15

          FillerWord = "parliamentarian"

       Case 16

          FillerWord = "quadruplications"

       Case 17

          FillerWord = "reclassifications"

       Case 18

          FillerWord = "spectrographically"

       Case 19

          FillerWord = "transmogrifications"

       Case 20

          FillerWord = "uncharacteristically"

       Case Else ' should not reach this ... just in case

          FillerWord = "21LettersPlus"

    End Select ' i

 

      

        ' Clear any Find/Replace settings before we start

        Selection.Find.ClearFormatting

        Selection.Find.Replacement.ClearFormatting

          

        With Selection.Find

             .Text = "[a-zA-Z]{" & Trim(Str(i)) & "}" ' Words of i length

            .Replacement.Text = FillerWord

            .MatchWholeWord = True  ' important to select all and only words.

            .MatchWildcards = True  ' to make the RegEx work

            .Forward = True

            .Wrap = wdFindContinue

            .Format = False

            .MatchCase = False

            .MatchKashida = False

            .MatchDiacritics = False

            .MatchAlefHamza = False

            .MatchControl = False

            .MatchAllWordForms = False

            .MatchSoundsLike = False

        End With

       

        ' Enable these lines to highlight any changes made

        Options.DefaultHighlightColorIndex = wdYellow

        Selection.Find.Replacement.Highlight = True

 

        Selection.Find.Execute Replace:=wdReplaceAll

 

    Next ' i

 

' Digits - replace any digit with 9

 

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

      

    With Selection.Find

        .Text = "[0-9]{1}"

        .Replacement.Text = "9"

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchKashida = False

        .MatchDiacritics = False

        .MatchAlefHamza = False

        .MatchControl = False

        .MatchAllWordForms = False

        .MatchSoundsLike = False

        .MatchWildcards = True

    End With

   

   

    ' Enable these two lines to highlight any changes made

    Options.DefaultHighlightColorIndex = wdYellow

    Selection.Find.Replacement.Highlight = True

   

    Selection.Find.Execute Replace:=wdReplaceAll

 

    End Sub

subs profile e1563205311409 - A better 'anonymize a Word document' solution
Latest news & secrets of Microsoft Office

Microsoft Office experts give you tips and help for Word, Excel, PowerPoint and Outlook.

Give it a try. You can unsubscribe at any time.  Office Watch has been running for over 20 years, we've never, ever revealed or sold subscriber details.  Privacy policy
Invalid email address