Search for font text and delete apart from certain words

[andrewdavies]

Hi all,

I'm new to posting to this site (but have used many pieces of code!) but I've come unstuck with VBA and need your help!

Essentially what I'm trying to do is go through a document and search for text of a particular font and delete said text, apart from in certain cases i.e. when the text line contains the word 'COLUMNS' or 'ROWS' for example. I'm tinkering with the below code, but need to set up these exclusions.

Thanks in advance!



Sub Demo()Dim lngColor As Long
Application.ScreenUpdating = False
lngColor = Selection.Range.Font.Color
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.Font.Color = lngColor
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub

[gmayor]

Your code searches for text with the font colour of the text at the cursor. The following recreates that and will omit matching texts that contain the strings in strList have.
You could change the colour for the font name, but either way make sure the cursor is in the required font before running the macro.



Sub Macro1()
'Graham Mayor - http://www.gmayor.com - Last updated - 22/12/2016
Const strFind As String = "COLUMNS|ROWS"
Dim oRng As Range
Dim vText As Variant
Dim lngColor As Long
Dim bFound As Boolean
Dim i As Long
vText = Split(strFind, "|")
lngColor = Selection.Range.Font.Color
Set oRng = ActiveDocument.Range
With oRng.Find
.Font.Color = lngColor
Do While .Execute()
bFound = False
For i = LBound(vText) To UBound(vText)
If InStr(1, oRng.Text, vText(i)) > 0 Then
bFound = True
Exit For
End If
Next i
If Not bFound Then oRng.Text = ""
oRng.Collapse 0
Loop
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub