Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 03-09-2023, 09:22 AM
Shelley Lou Shelley Lou is offline VBA help remove duplicates of blanks Windows 10 VBA help remove duplicates of blanks Office 2016
Competent Performer
VBA help remove duplicates of blanks
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default VBA help remove duplicates of blanks

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
Reply With Quote
  #2  
Old 03-09-2023, 03:50 PM
Guessed's Avatar
Guessed Guessed is offline VBA help remove duplicates of blanks Windows 10 VBA help remove duplicates of blanks Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

This modification appears to get all of them apart from the ones separated by a space. Do you want those as well?
Code:
Sub DeleteCoding()
  Dim Rng As Range
  
  'Application.ScreenUpdating = False
  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
    .Text = "[\[" & ChrW(9679) & "\]]{4,}"
    .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
    .Format = False
    .Font.Superscript = True         'remove superscript wording
    .Text = ""
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
  End With
  'Application.ScreenUpdating = True
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #3  
Old 03-10-2023, 06:51 AM
Shelley Lou Shelley Lou is offline VBA help remove duplicates of blanks Windows 10 VBA help remove duplicates of blanks Office 2016
Competent Performer
VBA help remove duplicates of blanks
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default VBA help remove duplicates of blanks

Hi Andrew, thank you for replying - I added your extra bit of code and I think it has removed a few of the duplicates but many still remain - with regard to your query re separated by spaces, yes that would be great if those could be included also.

Code:
.text = "[\[" & ChrW(9679) & "\]]{4,}"
    .Execute Replace:=wdReplaceAll
Capture 1.JPG

Capture 2.JPG
Reply With Quote
  #4  
Old 03-17-2023, 10:10 AM
Shelley Lou Shelley Lou is offline VBA help remove duplicates of blanks Windows 10 VBA help remove duplicates of blanks Office 2016
Competent Performer
VBA help remove duplicates of blanks
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default VBA help remove duplicates of blanks

Hi Andrew, I wondered if you had had a chance to look at the code, no worries if not, I have been doing a lot of research online but there isn't much out there relating to duplicates in Word, lots for excel but not a lot for Word. thanks again.
Reply With Quote
  #5  
Old 03-19-2023, 03:58 PM
Guessed's Avatar
Guessed Guessed is offline VBA help remove duplicates of blanks Windows 10 VBA help remove duplicates of blanks Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Try this version
Code:
Sub DeleteCoding()
  Dim Rng As Range
  
  'Application.ScreenUpdating = False
  Set Rng = Selection.Range
  With Rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .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
    .Format = False
    .Font.Superscript = True         'remove superscript wording
    .Text = ""
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    .MatchWildcards = True
    .ClearFormatting
    .Text = "[\{]{1,}[!\}]@[\}]{1,}" 'find text within curly braces and replace with square bracket blank
    .Replacement.Text = "[" & ChrW(9679) & "]"
    .Execute Replace:=wdReplaceAll
    .MatchWildcards = False
    .Text = "]^w["                    'remove spaces between ][
    .Replacement.Text = "]["
    .Execute Replace:=wdReplaceAll
    .MatchWildcards = True
    .Text = "[\[" & ChrW(9679) & "\]]{4,}"
    .Replacement.Text = "[" & ChrW(9679) & "]"
    .Execute Replace:=wdReplaceAll
  End With
  'Application.ScreenUpdating = True
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #6  
Old 03-20-2023, 05:48 AM
Shelley Lou Shelley Lou is offline VBA help remove duplicates of blanks Windows 10 VBA help remove duplicates of blanks Office 2016
Competent Performer
VBA help remove duplicates of blanks
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default VBA help remove duplicates of blanks

Andrew you are a genius, thank you so much, I worked on this all weekend and didn't get anywhere close, I really appreciate your help, best wishes - Shelley
Reply With Quote
  #7  
Old 03-21-2023, 10:50 AM
Shelley Lou Shelley Lou is offline VBA help remove duplicates of blanks Windows 10 VBA help remove duplicates of blanks Office 2016
Competent Performer
VBA help remove duplicates of blanks
 
Join Date: Dec 2020
Posts: 163
Shelley Lou is on a distinguished road
Default VBA help remove duplicates of blanks updated

Hi Andrew, I've tidied up the code a little bit with regard to searching and deleting the less than and greater than symbols which is working great. I'm trying to work out how to include the superscript text within those symbols to be deleted at the same. It does appear however that the less than symbol followed by blue superscript text doesn't always have a closing greater than symbol - I'm probably over thinking it too much and should leave it alone but I was just curious how I would include searching for text within two Chr values.

Code:
.text = "[" & Chr(60) & Chr(62) & "]"
    .Replacement.text = ""
    .Execute Replace:=wdReplaceAll
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
VBA help remove duplicates of blanks find/remove duplicates hephalumph Word 9 02-06-2022 07:23 PM
look for VBA to remove Duplicates from Subfolders nf24eg Outlook 0 08-12-2021 05:03 AM
Macro to keep first instance and remove duplicates in certain column zhead Excel 2 03-18-2015 10:16 AM
VBA help remove duplicates of blanks Counting Blanks in 1 Column and Non-Blanks in Another dogwood705 Excel 4 02-07-2015 08:45 AM
Macro to remove duplicates in Refrences list HowardC Word VBA 0 05-20-2010 09:57 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:02 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft