Clean Text - Remove Repeat Line Breaks

[lneidorf]

Hi there.

I've used Power Query to export a series of emails from MS Outlook.

The result includes a column of the email body. I used a simple find/replace operation (searching for "<*>") to strip out HTML tags. After doing so, I'm left with a series of line returns, one after the other, throughout the email body.

I've been trying to write some VBA code to find instances of multiple line breaks, one after the other, and replace them with a single line break. I imagine the easiest way to accomplish this is to do a series of fine/replace options, starting with a large number of line returns, and incrementing down all the way to two. Yet nothing I'm trying has worked.

I include an example of some pretty rudimentary code, which starts with four line returns and increments down to two. Probably not what's needed, but at least this demonstrates my thinking around this.

Note that my goal is NOT to eliminate all line returns; I still want to preserve a single return where multiple appear for the sake of readability.

Thanks!

Sub ReplaceMultipleLineReturns()

Dim MyRange As Range
For Each MyRange In ActiveSheet.UsedRange
Selection.Replace What:=Chr(10) & Chr(10) & Chr(10) & Chr(10), Replacement:=Chr(10), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Next

For Each MyRange In ActiveSheet.UsedRange
Selection.Replace What:=Chr(10) & Chr(10) & Chr(10), Replacement:=Chr(10), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Next

For Each MyRange In ActiveSheet.UsedRange
Selection.Replace What:=Chr(10) & Chr(10), Replacement:=Chr(10), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Next

End Sub

 

[mikerickson]

Try

Do Until Application.Countif(myRange, chr(10)&chr(10)) = 0
    myRange.Replace What:=Chr(10) & Chr(10), Replacement:=Chr(10), LookAt:=xlPart, _
         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
         ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Loop

 

[lneidorf]

Many thanks for the response!

Alas, this didn't seem to work. Betting I set this up wrong:

Sub Test3()
Dim MyRange As Range
For Each MyRange In ActiveSheet.UsedRange
Do Until Application.CountIf(MyRange, Chr(10) & Chr(10)) = 0
MyRange.Replace What:=Chr(10) & Chr(10), Replacement:=Chr(10), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Loop
Next
End Sub

 

[Rick Rothstein]

This macro will condense up to 26795 consecutive Line Feeds down to a single Line Feed. Note, though, that if there are multiple leading Line Feeds, the text will end up with a single Line Feed at the beginning and if there are multiple trailing Line Feeds, the text will end up with a single Line Feed at the end in each cell that has such a set up.

Sub RemoveMultipleLineFeeds()
  Dim vnum As Variant
  For Each vnum In Array(232, 22, 6, 4, 2, 2)
    Cells.Replace String(vnum, Chr(10)), Chr(10), xlPart, , , , False, False
  Next
End Sub

I can add code to remove these if they occur, but to do it (efficiently), I will need to know the version of Excel that you are using. You should update your profile so volunteers on future questions you ask will know without having to ask you.

 

[lneidorf]

This macro will condense up to 26795 consecutive Line Feeds down to a single Line Feed. Note, though, that if there are multiple leading Line Feeds, the text will end up with a single Line Feed at the beginning and if there are multiple trailing Line Feeds, the text will end up with a single Line Feed at the end in each cell that has such a set up.

Sub RemoveMultipleLineFeeds()
  Dim vnum As Variant
  For Each vnum In Array(232, 22, 6, 4, 2, 2)
    Cells.Replace String(vnum, Chr(10)), Chr(10), xlPart, , , , False, False
  Next
End Sub

I can add code to remove these if they occur, but to do it (efficiently), I will need to know the version of Excel that you are using. You should update your profile so volunteers on future questions you ask will know without having to ask you.

Many thanks, Rick.

I'm running O365, v 2401.