Sub ConcordanceBuilder(wdDoc As Document)
Dim StrIn As String, StrTmp As String, StrIncl As String, StrExcl As String
Dim i As Long, j As Long, k As Long
'Define the exlusions list
StrExcl = "a,am,and,are,as,at,b,be,but,by,c,can,cm,d,did,do,does,e,eg,en,eq,etc,f," & _
"for,g,get,go,got,h,has,have,he,her,him,how,i,ie,if,in,into,is,it,its,j,k,l," & _
"m,me,mi,mm,my,n,na,nb,no,not,o,of,off,ok,on,one,or,our,out,p,q,r,re,s,she,so," & _
"t,the,their,them,they,t,to,u,v,w,was,we,were,who,will,would,x,y,yd,you,your,z"
'Define an inclusions list for terms that otherwise don't survive the initial cleanup
StrIncl = "c/c++,c#"
With wdDoc
'Get the document's text
StrIn = .Content.Text
'Strip out unwanted characters
For i = 1 To 255
Select Case i
Case 1 To 38, 40 To 44, 46 To 64, 91 To 96, 123 To 144, 147 To 149, 152 To 171, 174 To 191, 247
StrIn = Replace(StrIn, Chr(i), " ")
End Select
Next
'Convert smart single quotes to plain single quotes & delete any at the start/end of a word
StrIn = Replace(Replace(Replace(Replace(StrIn, Chr(145), "'"), Chr(146), "'"), "' ", " "), " '", " ")
'Convert to lowercase
StrIn = " " & LCase(Trim(StrIn)) & " "
'Process the exclusions list
For i = 0 To UBound(Split(StrExcl, ","))
While InStr(StrIn, " " & Split(StrExcl, ",")(i) & " ") > 0
StrIn = Replace(StrIn, " " & Split(StrExcl, ",")(i) & " ", " ")
Wend
Next
StrIn = Replace(StrIncl, ",", " ") & StrIn
'Clean up any duplicate spaces
While InStr(StrIn, " ") > 0
StrIn = Replace(StrIn, " ", " ")
Wend
StrIn = " " & Trim(StrIn) & " "
j = UBound(Split(StrIn, " "))
For i = 1 To j
StrTmp = Split(StrIn, " ")(1)
'Find how many occurences of each word there are in the document
While InStr(StrIn, " " & StrTmp & " ") > 0
StrIn = Replace(StrIn, " " & StrTmp & " ", " ")
Wend
k = j - UBound(Split(StrIn, " "))
'If there's more than one occurence, add the word to our Find list
If k > 1 Then
strFnd = strFnd & " " & StrTmp
End If
j = UBound(Split(StrIn, " "))
Next
End With
End Sub