Microsoft Office Forums - View Single Post - [Solved] VBA help remove duplicates of blanks

Shelley Lou · 03-09-2023, 09:22 AM

I have today been given quite a few documents to house style and the first thing I need to do is to remove the coloured coding within the document. I have put together a small macro which deals with most of the tasks in one go, however, I can't work out how to remove duplicates of [●] to just one [●].

I then put these blank spaces into a text form field by using a find and replace ^c as I've never worked out how to add this step into a macro.

If anyone can help with the duplication issue that would be great. I've added a very small reduced size document as the ones I'm working on are 100+ pages.

coded test document.docx

coding 1.png

coding 2.png

Code:

Sub DeleteCoding()
Application.ScreenUpdating = False
Dim Rng As Range
With Selection.Range
Set Rng = Selection.Range
With Rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchWildcards = True
    .text = "[\{]{1,}[!\}]@[\}]{1,}" 'find text within curly braces and replace with square bracket blank
    .Replacement.text = "[" & ChrW(9679) & "]"
    .Execute Replace:=wdReplaceAll
    .MatchWildcards = False
    .text = "<"                      'remove all instances of less than symbol
    .Replacement.text = ""
    .Execute Replace:=wdReplaceAll
    .text = ">"                      'remove all instances of greater than sumbol
    .Replacement.text = ""
    .Execute Replace:=wdReplaceAll
    End With
    With Rng.Find
    .Format = False
    .Font.Superscript = True         'remove superscript wording
    .text = ""
    .Replacement.text = ""
    .Execute Replace:=wdReplaceAll
    End With
    Application.ScreenUpdating = True
    End With
End Sub