I have about 200 rows in a sheet which contain a column with multiline
cells, in other words, each row has a cell that has more then one line
in it (about 4-5 lines per cell, accomplished by alt+enter).
Now,
I want to make from each line in these cells a seperate cell, so I
would endup with about 1000 rows.
Is there a function I could use (or any other way) so I could do this
rather fast?
You've received two suggestions for converting cells with multiple 'lines' into
cells spanning multiple columns in the same row rather than spreading these
downwards in a single column. If you had, say,
Apple
Banana
Cherry
in multiple lines in cell A1 and wanted this to become Apple in A1, Banana in A2
and Cherry in A3, you'd either need a macro or you'd need to use another range
of cells to hold temporary results.
Macro first.
'---- begin VBA ----
Sub foo()
Dim a As String, c As Range, r As Range
Dim i As Long, j As Long, k As Long, n As Long, p As Long, q As Long
If Not TypeOf Selection Is Range Then Exit Sub
Set r = Selection.Areas(1).Columns(1)
a = r.Address(0, 0, xlA1, 0)
k = r.Rows.Count
n = Evaluate("SUMPRODUCT(LEN(" & a & ")-LEN(SUBSTITUTE(" & _
a & ",CHAR(10),"""")))") + k
Set r = r.Resize(n, 1)
q = 0
For i = n To 1 Step -1
If q = 0 Then
a = r.Cells(k, 1).Value
k = k - 1
q = Len(a)
End If
p = InStrRev(q, a, Chr(10))
If p > 0 Then
r.Cells(i, 1).Value = Mid(a, p + 1, q - p)
q = p - 1
Else
r.Cells(i, 1).Value = Left(a, q)
q = 0
End If
Next i
End Sub
'***************************************************
'* following function only needed under Excel 8/97 *
'***************************************************
Function InStrRev( _
sp As Long, _
fs As String, _
ss As String, _
Optional mt As Long = vbBinaryCompare _
) As Long
'-------------------------
Dim i As Long, k As Long, n As Long
n = Len(fs)
k = Len(ss)
If n = 0 Or sp > n Then
InStrRev = 0
Exit Function
ElseIf k = 0 Then
InStrRev = sp
Exit Function
End If
For i = sp To 1 Step -1
If i <= n - k + 1 Then
If StrComp(Mid(fs, i, k), ss, mt) = 0 Then
InStrRev = i
Exit Function
End If
End If
Next i
End Function
Formulas second:
If the range containing these cells were A1:A10, and columns X, Y and Z were
empty, enter the following formulas.
X1: [array formula]
=IF(ROW()-CELL("Row",$X$1)<SUMPRODUCT(LEN($A$1:$A$5&CHAR(10))
-LEN(SUBSTITUTE($A$1:$A$5,CHAR(10),""))),MATCH(ROW()
-CELL("Row",$X$1),MMULT(--(ROW($A$1:$A$5)>TRANSPOSE(ROW($A$1:$A$5))),
LEN($A$1:$A$5&CHAR(10))-LEN(SUBSTITUTE($A$1:$A$5,CHAR(10),"")))),"")
Y1:
=X1
Z1: [array formula]
=MID(INDEX($A$1:$A$5,X1),SMALL(IF(MID(CHAR(10)&INDEX($A$1:$A$5,X1),
ROW(INDIRECT("1:1024")),1)=CHAR(10),ROW(INDIRECT("1:1024"))),Y1),
SMALL(IF(MID(INDEX($A$1:$A$5,X1)&CHAR(10),ROW(INDIRECT("1:1024")),1)
=CHAR(10),ROW(INDIRECT("1:1024"))),Y1)-SMALL(IF(MID(CHAR(10)&
INDEX($A$1:$A$5,X1),ROW(INDIRECT("1:1024")),1)=CHAR(10),
ROW(INDIRECT("1:1024"))),Y1))
Select X1:Z1 and fill down into X2:Z2, then change the formula in Y2 to
Y2:
=IF(X2=X1,Y1+1,1)
Select X2:Z2 and fill down as far as needed until the col X formula evaluates to
"" and the col Z formula evaluates to #VALUE!. Clear the cells below the
bottommost non-error value in col Z, then select the cells containing values in
col Z, copy, paste special as values on top of the topmost cell in the original
range, and finally clear columns X, Y and Z.
