Create several line breaks in excel cell using Excel VBA - excel

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

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 2

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 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:"