On Sep 20, 7:29*pm, GS wrote:
Here's another way that allows you to choose where the output goes by
changing the constant 'lOutputCol' in the final loop. Also, it writes
to the worksheet one row at a time.

Sub SplitCellDataToCols()
* Dim v, vDataIn 'as type Variant
* Dim n&, x&, lRowsIn&, lColsOut& 'as type Long

* Const sDelimiter As String = " " '//revise to suit
* Const lOutputCol As Long = 2 '//revise to suit

* lRowsIn = ActiveSheet.UsedRange.Rows.Count
* vDataIn = Range(Cells(1, 1), Cells(lRowsIn, 1))

* 'Get the number of output columns
* For n = LBound(vDataIn) To UBound(vDataIn)
* * v = Split(vDataIn(n, 1), sDelimiter)
* * x = UBound(v) + 1: If x lColsOut Then lColsOut = x
* Next 'n

* 'Parse the data out (row by row)
* Application.ScreenUpdating = False
* For n = LBound(vDataIn) To UBound(vDataIn)
* * v = Split(vDataIn(n, 1), sDelimiter)
* * Cells(n, lOutputCol).Resize(1, lColsOut) = _
* * * Split(Join(v, sDelimiter) _
* * * & Application.WorksheetFunction.Rept(sDelimiter, _
* * * lColsOut - (UBound(v) + 1)), sDelimiter)
* Next 'n
* Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc
======================
Here is what I sent
Option Explicit

Sub LineEmUpSAS()
Dim i As Long
Dim lc As Long


Application.ScreenUpdating = False

Columns("D").TextToColumns Destination:=Range("D1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False

On Error Resume Next
For i = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
lc = Cells(i, Columns.Count).End(xlToLeft).Column - 4
Rows(i + 1).Resize(lc).Insert
Cells(i, "e").Resize(, lc).Copy
Cells(i + 1, "d").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
Transpose:=True
Cells(i, 1).Resize(, 3).AutoFill Destination:=Cells(i, 1).Resize(lc +
1, 3), Type:=xlFillCopy
Next i

'housekeeping
lc = Cells.Find("*", Cells(Rows.Count, Columns.Count) _
, , , xlByColumns, xlPrevious).Column
Columns("e").Resize(, lc).Delete
Columns("B:D").WrapText = False
Range("c1:D1").WrapText = True
Columns("D").NumberFormat = "@"
Columns("b").AutoFit
Columns("a").ColumnWidth = 6
Columns("C").ColumnWidth = 9.22
Columns("D").ColumnWidth = 7.33
Rows.AutoFit
ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous
Range("b2").Select

Application.ScreenUpdating = True
End Sub