Hi guys,

I'm new to this forum and have attempted to do a search for this information but can't find anything quite relevant - so I apologise if it's been posted before!

Basically I have a hundred or so documents at work, each about 50 pages which need to be anonymised - removing references to he/she, dates, names, places etc. so that they effectively can't be traced back to who they are referring to.

I did 50 or so manually and decided that was a waste of time, 100 more to go and it's time to make a macro to do it for me. So far I've modified someone else's 'find and highlight' code to find and replace a list of names with [REMOVED] in red, this has worked to an extent. The list of names is about 10,000 long and is in Word format, on name per line e.g.

John
Bill
Rob
James

and so on. Obviously I only want it to find the whole and exact word and replace that, for example I don't want the name 'Mee' to cause the word 'Meeting' to become '[REMOVED]ting'. It does this quite well for the first few entries on the list and then after that starts to pick them out in a string of characters. I'm totally confused by this as I can't work out what changes after 30 or so lines in the list!

Code is as follows:

[VBA]

Sub Anonymouse()
Dim sCheckDoc As String
Dim docRef As Document
Dim docCurrent As Document
Dim wrdRef As String
Dim wrdPara As Paragraph


sCheckDoc = "d:\checklist.doc"
Set docCurrent = Selection.Document
Set docRef = Documents.Open(sCheckDoc)
docCurrent.Activate

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Font.Color = wdColorRed
.Replacement.Text = "[REMOVED]"
.Forward = True
.Format = True
.MatchWholeWord = True
.MatchCase = True
.MatchWildcards = False
End With

For Each wrdPara In docRef.Paragraphs
wrdRef = wrdPara.Range.Text
' remove the paragraph mark:
wrdRef = Left(wrdRef, Len(wrdRef) - 1)
If Asc(Left(wrdRef, 1)) > 32 Then
With Selection.Find
.Wrap = wdFindContinue
.Text = wrdRef
.Execute Replace:=wdReplaceAll
End With
End If
Next wrdPara

docRef.Close
docCurrent.Activate
End Sub
[/VBA]

Any help would be massively appreciated.

Cheers guys.