2

I try to found a solution for this for sometime now. I generate specific report every month and use this report to automatically generate invoices.

One of the report cells include data similar to this

Contract Ref: #Service Schedule 001 Site A: No, 22, ABC Road,City A: TSV Site 
B: Home exchange  City B: TSV Service ID: xxxxxxxxxxx W/O: 123 Capacity: Multiple

I need to force line breaks to all these cells that looks like this after that.

Contract Ref: #
Service Schedule 001 
Site A: No, 22, ABC Road, 
City A: TSV 
Site B: Home exchange  
City B: TSV 
Service ID: xxxxxxxxxxx 
W/O: 123 
Capacity: Multiple

Can some one help me with that?

RubberDuck
  • 11,933
  • 4
  • 50
  • 95
Isu
  • 127
  • 4
  • 15

3 Answers3

1

You could use the following UDF

Function SplitText(r As Range) As String

Dim i As Integer, ii As Integer

    i = Application.Find("Service S", r)
    SplitText = SplitText & Left(r, i - 1) & vbLf
    ii = Application.Find("Site A", r)
    SplitText = SplitText & Mid(r, i, ii - i) & vbLf
    i = Application.Find("City A", r)
    SplitText = SplitText & Mid(r, ii, i - ii) & vbLf
    ii = Application.Find("Site B", r)
    SplitText = SplitText & Mid(r, i, ii - i) & vbLf
    i = Application.Find("City B", r)
    SplitText = SplitText & Mid(r, ii, i - ii) & vbLf
    ii = Application.Find("Service ID", r)
    SplitText = SplitText & Mid(r, i, ii - i) & vbLf
    i = Application.Find("W/O", r)
    SplitText = SplitText & Mid(r, ii, i - ii) & vbLf
    ii = Application.Find("Capacity", r)
    SplitText = SplitText & Mid(r, i, ii - i) & vbLf
    SplitText = SplitText & Right(r, Len(r) - i + 1)

End Function

After entering the formula in the destination cell you will need to format the destination cell as Wrap Text.

e.g. If text is in A1 and destination cell is A4, then in A4 put =SplitText(A1) and the format A4 to Wrap Text.

KjBox
  • 65
  • 9
0

To add a newline character in Excel via VBA, you have to use Chr(10).

For instance, the code below adds a newline character after every character in the selected cell.

You will have to find the way to tell your code where are the appropriate points to insert the newlines.

Sub insert_nl()
    Dim rng As Range
    Set rng = Selection
    Dim ic As Integer, nc As Integer
    Dim s1 As String, s2 As String
    s1 = rng.Value
    nc = Len(s1)
    s2 = ""
    For ic = 1 To nc - 1
        s2 = s2 & Mid(s1, ic, 1) & Chr(10)   ' This line adds the newline character
    Next ic
    s2 = s2 & Mid(s1, nc, 1)
    rng.Value = s2
End Sub
  • Thx for the quick response. I am not an expert in VB. Could you please at least help me by putting the line break before Service Schedule? – Isu Jan 07 '15 at 05:57
  • When I select the relevant cell and use this code, it stack all the characters vertically.... – Isu Jan 07 '15 at 06:01
  • @Isu - As posted, "the code below adds a newline character after every character in the selected cell." That is why it stacks all the characters vertically. It was meant just as an example. Please take it as such. Interpret what each line is doing (it is quite simple), and adapt it to your needs. The `&` character means string concatenation. You will have to find the way to tell your code where are the appropriate points to insert the newlines. – sancho.s ReinstateMonicaCellio Jan 07 '15 at 06:34
  • @sancho.s FYI: Chr(10) = vbLf – Gene Skuratovsky Jan 07 '15 at 12:31
0

Here is a slightly different approach:

Option Explicit

Private Const sFldNames = ",Contract Ref:,Service Schedule,Site A:,City A:,Site B:,City B:,Service ID:,W/O:,Capacity:"

'Call this Sub with the parameters supplied and it is done
Private Sub SplitReportString(sRpt As String, sTabName As String, row As Long, col As Long)
'sTabName is the worksheet's name you want to write your output to
'row and col is where you want to start writing your output at
    Dim vFldNamesArray As Variant
    Dim i As Long
    Dim vRptArray As Variant

    vFldNamesArray = Split(sFldNames, ",")
    For i = 1 To UBound(vFldNamesArray, 1)
        sRpt = Replace(sRpt, vFldNamesArray(i), "," & vFldNamesArray(i))
    Next
    vRptArray = Split(sRpt, ",")
    With ThisWorkbook.Worksheets(sTabName)
        For i = 1 To UBound(vRptArray)
            .Cells(row + i - 1, col) = vRptArray(i)
        Next
    End With
End Sub