Removing Extra Line Spaces

Jetheat · #1 11-11-2023, 05:14 AM

I have a document which I receive on a daily basis.

It contains a table with multiple rows.

Each row has different bullet points (although the bullets are not there).

Each of these points have various line spaces between them.

I need a quick way (like a Macro) that will do this:

- Remove all line spaces between each point. Each point should be on its own line.
- Add a bullet point to each line.
- Remove the phrase !!Edit as necessary!!
- Change fire resistant to fire-resistant

Word Doc attached

Any ideas on how I can do this quickly?

Appreciate the help,
JH

Guessed · #2 11-11-2023, 02:26 PM

Here is a macro which calls out to a function for the repetitive stuff. It does all those things you asked for.

Code:

Sub TableCleanup()
  Dim aTbl As Table, aCell As Cell, aRng As Range, sEoC As String
  Set aTbl = ActiveDocument.Tables(ActiveDocument.Tables.Count)
  sEoC = Chr(13) & Chr(7)
  TableSearchReplace aTbl, "!!Edit as necessary!!", "", False
  TableSearchReplace aTbl, "^p^w", "^p", False
  TableSearchReplace aTbl, "^w^p", "^p", False
  TableSearchReplace aTbl, "^13{2,}", "^p", True
  TableSearchReplace aTbl, "re re", "re-re", False
  TableSearchReplace aTbl, "preferebly", "preferably", False
  For Each aCell In aTbl.Range.Cells
    Set aRng = aCell.Range
    Do While aRng.Characters.Last.Previous = Chr(13) And Len(aRng.Text) > 2
      aRng.Characters.Last.Previous.Delete
    Loop
    Do While aRng.Characters.First = Chr(13)
      aRng.Characters.First.Delete
    Loop
    If aCell.ColumnIndex = 2 And aCell.RowIndex > 1 Then aCell.Range.Style = "List Bullet"
  Next aCell
End Sub
Function TableSearchReplace(aTbl As Table, sFind As String, sReplace As String, Optional bWC As Boolean = False)
  With aTbl.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = sFind
    .Format = False
    .Replacement.Text = sReplace
    .Forward = True
    .Wrap = wdFindStop
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = bWC
    .Execute Replace:=wdReplaceAll
  End With
End Function

Jetheat · #3 11-11-2023, 04:48 PM

I don't believe this. This is so useful and will save me hours of cumulative formatting.
Thank you so much Andrew.

Just one addition...

Can I modify the code to also remove any full stops from the end of all those bullet points (only the full-stops right at the end of the sentence)?

JH

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Removing extra space between word	BillMcEnaney	Word	9	02-16-2023 11:03 PM
Signature Block has extra spaces	CDiedolf	Outlook	1	04-15-2021 01:00 AM
How do I delete extra spaces between words in Word for Mac	Waugust	Word	3	07-09-2020 11:18 AM
Removing extra pages	mohsen.amiri	Word	12	11-21-2018 09:06 AM
Removing indentations at beginning of paragraphs and replacing with line spaces	captainamerica	Word	2	10-27-2017 05:32 PM