View Single Post
 
Old 10-02-2020, 06:41 AM
jarjarb jarjarb is offline Windows 10 Office 2019
Novice
 
Join Date: Oct 2020
Posts: 1
jarjarb is on a distinguished road
Default Macro for fixing abnormally formatted paragraph line breaks

Hey all,

I was wondering if someone can help me with an issue. I have been using a Macro to format incorrectly formatted line breaks. For example:

Hey my name
is Jarjarb52

to

Hey my name is Jarjarb52

However, I was wondering if this Macro can be changed in a couple ways:
1) If there is a capital letter, a quote sign ("), or a number (1,2,3,etc), then it should not remove the line break
2) If there is a double line break, it should not get rid of it. Ex:
"Hey my name is Jarjarb52.

Today is a sunny day"
In this case, it should leave it as is.

Can anyone tell me how to edit the following macro to do these two things?

Code:
Sub CleanUpPastedText()
    Application.ScreenUpdating = False
    With Selection.Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchWildcards = True
      'Eliminate spaces & tabs before paragraph breaks.
      .Text = "[ ^s^t]{1,}^13"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
      'Replace single paragraph breaks with a space
      .Text = "([!^13])([^13])([!^13])"
      .Replacement.Text = "\1 \3"
      'Replace all double spaces with single spaces
      .Execute Replace:=wdReplaceAll
      .Text = "[ ]{2,}"
      .Replacement.Text = " "
      'Delete hypens in hyphenated text formerly split across lines
      .Execute Replace:=wdReplaceAll
      .Text = "([a-z])-[ ]{1,}([a-z])"
      .Replacement.Text = "\1\2"
      .Execute Replace:=wdReplaceAll
      'Limit paragraph breaks to one per 'real' paragraph.
      .Text = "[^13]{1,}"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
    End With
    'Restore Screen Updating
    Application.ScreenUpdating = True
End Sub
Reply With Quote