Reply to thread

Message: [QUOTE="Helmut Weber, post: 5793348"] Hi Joel, depending on your doc's structure, this one might be pretty fast: Sub RemoveUnequal(lSiz As Long) Dim rPrg As Paragraph ' a paragraph Dim rSnt As Range ' a sentence Dim rWrd As Range ' a word Dim rChr As Range ' a character Dim lTmp As Long ' a temporary font size ActiveDocument.Characters.Last.Font.Size = lSiz ' preventing an endless loop ' as the last paragraph mark in a doc can't be deleted For Each rPrg In ActiveDocument.Paragraphs lTmp = rPrg.Range.Font.Size If lTmp <> lSiz And lTmp <> 9999999 Then rPrg.Range.Delete End If If lTmp = 9999999 Then For Each rSnt In rPrg.Range.Sentences lTmp = rSnt.Font.Size If lTmp <> lSiz And lTmp <> 9999999 Then rSnt.Delete End If If lTmp = 9999999 Then For Each rWrd In rSnt.Words lTmp = rWrd.Font.Size If lTmp <> lSiz And lTmp <> 9999999 Then rWrd.Delete End If If lTmp = 9999999 Then For Each rChr In rWrd.Characters If rChr.Font.Size <> lSiz Then rChr.Delete End If Next End If Next End If Next End If Next End Sub Sub Test63401() RemoveUnequal 12 End Sub The idea, explained for beginners, is to check first paragraphs, then sentences, then words, then characters. Font.size returns 9999999, if there are different font sizes. So if the font.size is <> 9999999 and <> 12, the range has a uniform font.size <> 12 and can be deleted. Otherwise, we proceed to the next smaller unit, sentences, and repeat the check for the font.size... HTH -- Greetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" [/QUOTE]

Verification