Adding Text after every line on the same cell - vba

Question

I have the following Excel cells:
D001
D002
D003
345
(In the same cell)
I need to add a string of text after every line on the same cell, like this:
D001 First Text
D0002 Second Text
D003 Third Text
345 Fouth Text
I found a code which allows me to count how many lines there are on the same cell, but I dont find any way of using it to write after the text on each of those lines:
Public Sub CountLines()
Dim H1 As Double
Dim H2 As Double
Dim row As Long
row = 1
While Cells(row, 1).Value <> ""
With Cells(row, 1)
.WrapText = False
H1 = .height
.WrapText = True
H2 = .height
.Offset(0, 1).Value = H2 / H1
End With
row = row + 1
Wend
End Sub
I guess the right way of doing it is by using a For to write text before any change of line he finds (Ch(10)) on VBA, but i havent been able to make it work
Thanks for the help.

Answer 1

Adding Text To Count Line Breaks
This code will loop through all cells with any value in Column A.
I have recreated your data set in my Excel:
The code will break up each line, add which line it is, and move on to the next:
Below is the code:
Sub AddText()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim myCell As Variant, myRange As Range, tempArr() As String
Dim i As Integer
Set myRange = ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))
For Each myCell In myRange
tempArr = Split(myCell, Chr(10))
myCell.Value = ""
For i = 0 To UBound(tempArr)
tempArr(i) = tempArr(i) & " text " & i
If i = UBound(tempArr) Then
myCell.Value = myCell.Value & tempArr(i)
Else: myCell.Value = myCell.Value & tempArr(i) & Chr(10)
End If
Next i
Next myCell
End Sub
If you want it to count from base 1 instead of base 0, change the lines myCell.Value = myCell.Value & tempArr(i) (and the following one in the If statement) to myCell.Value = myCell.Value & tempArr(i) + 1
I should mention again that this is already set up for a dynamic range in Column A. Meaning if you add more data formatted the same way in A2, the code will apply itself to that as well, all the way to the last set of data in column A.

Answer 2

Dim arr() As String
Dim arr2() As String
arr = Split(yourCell, char(10))
arr2 = Split("first, second, third", "," )
For i = 1 To UBound(arr)
debug. print arr(i) + arr2(i)
next i
after rebuilding the new string the new string assign it back to the cell

Answer 3

This will only place (random) text after each line in the cell. But it gives you a place to start.
Option Explicit
Public Sub RePrint()
Dim MyRange As Range
Dim MyArray As Variant
Dim i As Long
Set MyRange = Range("A1")
MyArray = Split(MyRange, Chr(10))
For i = LBound(MyArray) To UBound(MyArray)
MyArray(i) = MyArray(i) & " Text" & i
Next i
MyRange = Join(MyArray, Chr(10))
End Sub

Answer 4

you could use this function:
Function AddText(rng As Range, textsArr As Variant) As String
Dim nTexts As Long, nLines As Long, iLine As Long
Dim linesArr As Variant
nTexts = UBound(textsArr) - LBound(textsArr) + 1
With rng
linesArr = Split(.Value, vbLf)
nLines = UBound(linesArr) - LBound(linesArr) + 1
If nTexts < nLines Then nLines = nTexts
For iLine = 1 To nLines
linesArr(LBound(linesArr) - 1 + iLine) = linesArr(LBound(linesArr) - 1 + iLine) & " " & textsArr(LBound(textsArr) - 1 + iLine)
Next iLine
AddText = Join(linesArr, vbLf)
End With
End Function
to be exploited as follows
Option Explicit
Sub main()
Dim cell As Range
Dim additionalTexts As Variant
additionalTexts = Array("First Text", "Second Text", "Third Text", "Fourth Text") '<--| set your array of additional text, each element index corresponding to to be processed cell content line
With Worksheets("ADDTEXT") '<--| reference your relevant worksheet (change "ADDTEXT" to your actual relevant worksheet name)
For Each cell In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) '<--| reference its column "A" cells form row 1 down to last not empty row
cell.Value = AddText(cell, additionalTexts) '<--| process
Next cell
End With
End Sub

Answer 5

This will but in the text "First Line", "Second Line"... after each line. The way it is set up now uses the value in A1 and replaces the value in A1. It is ideal for cells with 4 lines or less, but it will work with more.
Sub appendCharacters()
Dim lines() As String
Dim text As String
lines = Split(Range("A1"), Chr(10))
Range("A1").Value = ""
For i = LBound(lines) To UBound(lines)
Select Case i
Case 0
text = " First Line"
Case 1
text = " Second Line"
Case 2
text = " Third Line"
Case 3
text = " Fourth Line"
Case Else
text = " Another Line"
End Select
lines(i) = lines(i) + text
Range("A1").Value = Range("A1").Value + lines(i)
If i <> UBound(lines) Then
Range("A1").Value = Range("A1").Value + vbCrLf
End If
Next i
End Sub