Remove empty lines from selected cells

Question

I am trying to remove only empty lines from cells in excel. Here is what I'm trying to accoplish:

+-----------------+    +---------------------+    +---------------------+
|  EXAMPLE DATA   |    |    EXPLANATION      |    |   EXPECTED RESULT   |
+-----------------+    +---------------------+    +---------------------+
| cell1_text1     |    | cell1_text1         |    | cell1_text1         |
| cell1_text2     |    | cell1_text2         |    | cell1_text2         |
+-----------------+    +---------------------+    +---------------------+
|                 |    | cell2_empty_line    |    | cell2_text1         | 
| cell2_text1     |    | cell2_text1         |    +---------------------+ 
+-----------------+    +---------------------+    | cell3_text1         | 
| cell3_text1     |    | cell3_text1         |    | cell3_text2         | 
|                 |    | cell3_emptyline     |    +---------------------+ 
| cell3_text2     |    | cell3_text2         |    | cell4_text1         | 
+-----------------+    +---------------------+    +---------------------+ 
|                 |    | cell4_emptyline     |    | cell5_text1         | 
|                 |    | cell4_emptyline     |    +---------------------+ 
| cell4_text1     |    | cell4_text1         |    | cell6_text1         | 
+-----------------+    +---------------------+    | cell6_text2         | 
| cell5_text1     |    | cell5_text1         |    | cell6_text3         | 
+-----------------+    +---------------------+    | cell6_text4         | 
| cell6_text1     |    | cell6_text1         |    +---------------------+ 
| cell6_text2     |    | cell6_text2         |
| cell6_text3     |    | cell6_text3         |
|                 |    | cell6_emptyline     |
| cell6_text4     |    | cell6_text4         |
+-----------------+    +---------------------+

I have found this script:

Sub RemoveCarriageReturns()
    Dim MyRange As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For Each MyRange In ActiveSheet.UsedRange
        If 0 < InStr(MyRange, Chr(10)) Then
            MyRange = Replace(MyRange, Chr(10), "")
        End If
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

but it doesn't give me desired result, it removes all breaklines in all cells.

+---------------------------------------------+
|          CURRENT SCRIPT RESULT              |
+---------------------------------------------+
| cell1_text1cell1_text2                      |
+---------------------------------------------+
| cell2_text1                                 |
+---------------------------------------------+
| cell3_text1cell3_text2                      |
+---------------------------------------------+
| cell4_text1                                 |
+---------------------------------------------+
| cell5_text1                                 |
+---------------------------------------------+
| cell6_text1cell6_text2cell6_text3cell6_text4|
+---------------------------------------------+

How can I test if row doesn't contain any other letter and delete only that row within cell? How can I apply that macro only to currenty selected cells?

Answer 1

You need to locate and remove errant line feed characters (e.g. vbLF, Chr(10) or ASCII 010 dec). If the data was copied from an external source, it is possible that rogue carriage return characters (e.g. vbCR or Chr(13)) may have piggy-backed along and these should be scrubbed as well.

Sub clean_blank_lines()
    Dim rw As Long
    
    With Worksheets("Sheet3")   '<~~SET THIS WORKSHEET REFERENCE PROPERLY!
        For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            With .Cells(rw, 1)
                .Value = Replace(.Value2, Chr(13), Chr(10))
                Do While Left(.Value2, 1) = Chr(10): .Value = Mid(.Value2, 2): Loop
                Do While CBool(InStr(1, .Value, Chr(10) & Chr(10)))
                    .Value = Replace(.Value2, Chr(10) & Chr(10), Chr(10))
                Loop
                Do While Right(.Value2, 1) = Chr(10): .Value = Left(.Value2, Len(.Value2) - 1): Loop
            End With
            .Rows(rw).EntireRow.AutoFit
        Next rw
    End With
End Sub

A Range.AutoFit is performed on the finished cell to remove dead 'white space'.

                
                 _{Before                                After}

To convert this to a macro that processes one or more selected cells, see Examples of Selection-based sub framework in How to avoid using Select in Excel VBA macros.

Answer 2

This will do it:

Instead of replacing the carriage returns, split on it then loop through and replace the value with only those items that have a value.

Sub RemoveCarriageReturns()
    Dim MyRange As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For Each MyRange In ActiveSheet.UsedRange
        Dim textArr() As String
        textArr = Split(MyRange.Value, Chr(10))
        MyRange.Value = ""
        For i = LBound(textArr) To UBound(textArr)
            If textArr(i) <> "" Then
                If MyRange.Value = "" Then
                    MyRange.Value = textArr(i)
                Else
                    MyRange.Value = MyRange.Value & Chr(10) & textArr(i)
                End If
            End If
        Next i
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub