Sub PárrafPalabRepetidas()
' Paul Beverley - Version 30.12.21
' Resalta las palabras repetidas en cada párrafo.

wdsIgnore = ",a,de,en,desde,sobre,para,por,con,sin,si"
wdsIgnore = wdsIgnore & ",un,uno,una,unos,unas,el,la,las,los,lo,esta,estas,esto,estos,este,ese,esa,eso,esas,esos,aquel,aquella,aquellos,aquellas"
wdsIgnore = wdsIgnore & ",es,son,eran,estaba,estaban,está,que,ha,había,han,habían"
wdsIgnore = wdsIgnore & ",it" & ChrW(8217) & "s," ' This is for "it's"

useHighlight = True
useColour = False
useManyColours = True

Dim myCol(20)
myCol(1) = wdYellow
myCol(2) = wdBrightGreen
myCol(3) = wdTurquoise
myCol(4) = wdPink

myCol(11) = wdColorPink
myCol(12) = wdColorBlue
myCol(13) = wdColorRed
myCol(14) = wdColorBrightGreen
myColTotal = 4

myCount = 0
col = 1
parNum = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
For par = parNum To ActiveDocument.Paragraphs.Count
 Set pa = ActiveDocument.Paragraphs(par)
 txt = LCase(pa.Range.Text)
 lenpar = Len(txt)
 wds = ","
 For i = 1 To pa.Range.Words.Count
 wd = LCase(Trim(pa.Range.Words(i)))
 lnw = Len(wd)
 If lnw > 3 And InStr(wdsIgnore, "," & wd & ",") = 0 Then
  Set rng = pa.Range.Duplicate
  rs = rng.Start
  newtxt = Replace(txt, wd, "")
  If (lenpar - Len(newtxt)) > lnw And _
   InStr(wds, "," & wd & ",") = 0 Then
  wds = wds & wd & ","
  For j = 1 To lenpar - lnw
   If Mid(txt, j, lnw) = wd Then
   rng.Start = rs + j - 1
   rng.End = rng.Start + lnw
   If useHighlight Then
    rng.HighlightColorIndex = myCol(col)
   End If
   If useColour Then
    rng.Font.Color = myCol(col + 10)
   End If
   j = j + lnw
   End If
  Next j
  If useManyColours Then col = col Mod myColTotal + 1
  DoEvents
  End If
 End If
 DoEvents
 Next i
 myCount = myCount + 1
 If myCount = 20 Then
 pa.Range.Words(1).Select
 myCount = 0
 End If
Next par
End Sub