delete Blank lines in cell

[Clare1805]

I have a large spreadsheet of 1000+ rows showing details of ICT issues logged on a service desk. Column B is text and therefore contains blank lines within the cell - is there anyway of removing these blank lines by means of a formula/macro?

<TABLE style="WIDTH: 176pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=234 border=0 x:str><COLGROUP><COL style="WIDTH: 176pt; mso-width-source: userset; mso-width-alt: 8557" width=234><TBODY><TR style="HEIGHT: 76.5pt; mso-height-source: userset" height=102><TD class=xl65 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 176pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 76.5pt; BACKGROUND-COLOR: transparent" width=234 height=102>for example

this cell contains blank rows

within the cell</TD></TR></TBODY></TABLE>

 

[Peter_SSs]

The following code will be much faster and will effectively collapse from 2 up to as many as 9840 consecutive line feeds in any cell in Column B down to single line feeds for each set of consecutive line feeds in the cells...

Sub RemoveBlankLines_V3()
  Dim V As Variant
  For Each V In Array(121, 13, 5, 3, 3, 2)
    Columns("B").Replace What:=String(V, vbLf), Replacement:=vbLf, LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
  Next
End Sub

With my sample data, this reduces the time by about another 85%

Sub RemoveBlankLines_V4()
  Dim a
  Dim s As String
  Dim i As Long, Rws As Long

  a = Range("B1", Range("B" & Rows.Count).End(xlUp)).Value
  Rws = UBound(a, 1)
  With CreateObject("VBScript.RegExp")
    .Pattern = vbLf & "{2,}"
    .Global = True
    For i = 1 To Rws
      s = a(i, 1)
      a(i, 1) = .Replace(s, vbLf)
    Next i
  End With
  Range("B1").Resize(Rws) = a
End Sub