insert row

[Endeavouring]

Hi
I have a column of data that has in each cell multiline entries with each line broken with a line feed char(10).
<TABLE style="WIDTH: 48pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=64><COLGROUP><COL style="WIDTH: 48pt" width=64><TBODY><TR style="HEIGHT: 38.25pt" height=51><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 38.25pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" class=xl63 height=51 width=64>line1
line 2
line3</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=17></TD></TR></TBODY></TABLE>
I want to select the column and run the VBA so as every time it encounters a line feed, it insert a new row. So in the example data, it would end up with the data split into three rows (line 1 in original cell, lines 2&3 in new cells beneath original cell.

Is it possible, I don't know where to start so any help would be appreciated.

 

[Tom Urtis]

Care to specify which column it is with these Chr(10)'s or is it any column in the used range.

 

[Endeavouring]

Hi
it could be in any row but for the sake of the example, let's say it is in column "C". I also forgot to say that some cells in the column may only have single entries or be blank.

Thanks for your interest

 

[Tom Urtis]

This is one way to go about it but you are leaving out information about your spreadsheet that I bet will have bearing on the best approach. If it were only column C that is populated then this would probably do what you want, but because it sounds like there are other columns, maybe this will be OK or maybe it won't. It does work but run it on a copy of your worksheet first.

Sub TestSplit()
Application.ScreenUpdating = False
Dim xRow&, intChr%
Dim vText As Variant, x&
For xRow = Cells(Rows.Count, 3).End(xlUp).Row To 3 Step -1
If InStr(Cells(xRow, 3).Value, Chr(10)) > 0 Then
intChr = _
Len(Cells(xRow, 3).Value) - _
Len(WorksheetFunction.Substitute(Cells(xRow, 3).Value, Chr(10), ""))
Rows(xRow + 1).Resize(intChr + 1).Insert
vText = Split(Cells(xRow, 3).Value, Chr(10))
For x = 0 To UBound(vText)
Cells(xRow + x + 1, 3).Value = vText(x)
Next x
Rows(xRow).Delete
End If
Next xRow
Application.ScreenUpdating = True
End Sub

 

[Endeavouring]

Hi Tom

It works fine, but when it encounters a multline cell it deletes all data in columns "A" & "B"

Sorry I can't post sample data but I can't download HTML Maker, do you know of an alternative

 

[Endeavouring]

Tom
Just been called into meeting, should be back on line within the hour

 

[Tom Urtis]

Sub SonOfTestSplit()
Application.ScreenUpdating = False
Dim xRow&, intChr%
Dim vText As Variant, x&
For xRow = Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
If InStr(Cells(xRow, 3).Value, Chr(10)) > 0 Then
intChr = _
Len(Cells(xRow, 3).Value) - _
Len(WorksheetFunction.Substitute(Cells(xRow, 3).Value, Chr(10), ""))
Rows(xRow + 1).Resize(intChr).Insert
vText = Split(Cells(xRow, 3).Value, Chr(10))
For x = 0 To UBound(vText)
Cells(xRow + x, 3).Value = vText(x)
Next x
End If
Next xRow
Application.ScreenUpdating = True
End Sub

 

[Endeavouring]

Tom

Many many thanks, works a dream