Create several line breaks in excel cell using Excel VBA

Question

I will try to explain the issue as clear as possible.
I have a column in an Excel file and each cell in this column contains a description of some issue. The description has four levels such as Name , Issue , Solution and Result , all these four in the same cell.

I need VBA code that will find each level in each cell and create line break in the cell.
So instead of this:

Name: 123 Issue: My issue: Solution: Try to resolve Result: Resolved.

After the code runs will be like this:

  Name: 123 (line break) 
  Issue: My issue (line break) 
  Solution: Try to resolve (line break)  
  Result: Resolved (line break) 

Please let me know if there is any solution?

Answer 1

loop through the cells and add linefeeds.

sub makelfs()

    dim i as long, j as long, arr as variant, str as string

    arr = array("Issue:","Solution:","Result:")

    with worksheets("excel file")

        for i=2 to .cells(.rows.count, "a column in excel file").end(xlup).row
            str = .cells(i, "a column in excel file").value2
            for j = lbound(arr) to ubound(arr)
                str = replace(str, arr(j), vblf & arr(j)) 
            next j
            .cells(i, "a column in excel file") = str
            .cells(i, "a column in excel file").wraptext = true
        next i

    end with

end sub

Answer 2

Select the cell containing the data and run:

Sub FixData()
    Dim r As Range
    Set r = ActiveCell
    t = r.Text
    t = Replace(t, "Issue:", Chr(10) & "Issue:")
    t = Replace(t, "Solution:", Chr(10) & "Solution:")
    t = Replace(t, "Result:", Chr(10) & "Result:")
    r.Value = t
    r.WrapText = True
End Sub

If necessary, you can put this in a loop.

Answer 3

s = "Name: 123 Issue: My issue: Solution: Try to resolve Result: Resolved."
arr = Split(s, Chr(32))
For Each Item In arr
    If cnt > 0 Then
        If Right(Item, 1) = ":" Then Item = vbCrLf & Item
    End If

    output = output & Item & " "
    cnt = cnt + 1
Next Item
Debug.Print output

Answer 4

Using a slightly different approach which doesn't rely on Issue , Solution and Result being present.
As said in my comment - look for the first space before the colon and replace it with a line feed (put vbcr in my comment - should be vblf ).

Public Function AddLineBreak(Target As Range) As String

    Dim lColon As Long
    Dim lSpace As Long

    Dim sFinal As String

    sFinal = Target.Value
    lSpace = Len(sFinal)

    Do While lSpace <> 0

        sFinal = Left(sFinal, lSpace - 1) & Replace(sFinal, " ", vbLf, lSpace, 1)

        lColon = InStrRev(sFinal, ":", lSpace - 1)
        lSpace = InStrRev(sFinal, " ", lColon)

    Loop

    AddLineBreak = Trim(sFinal)

End Function  

You can call the function in a procedure:

Sub Test()

    Dim rCell As Range

    For Each rCell In Sheet1.Range("A1:A13")
        rCell = AddLineBreak(rCell)
    Next rCell

End Sub  

or as a worksheet function:
=AddLineBreak(A1)

This assumes an error in the original string you posted:
Name: 123 Issue: My issue: Solution: Try to resolve Result: Resolved. should be
Name: 123 Issue: My issue Solution: Try to resolve Result: Resolved.
(extra colon before Solution which is not shown in your After code example).

Edit - it also means you cannot have spaces in your headings. So you can have " Issue:" or " My_Issue:" but not " My Issue:"