Creating Columns from space delimited list

[mt engineer]

I have a list of distances and elevations from a certain point.

i.e. 8000 5230 7000 5231 6000 5233

That is about 500 numbers long. I would like to take the information and
split it into two columns.

i.e. 8000 5230
7000 5231
6000 5233

I have tried several ways of find and replace to no avail. Is there a VB
code to do this?

 

[JLatham]

Try this macro - to put it into your workbook, open the workbook and press
[Alt]+[F11] to open the Visual Basic Editor. In the VBE, choose Insert |
Module
copy and paste the code below into the empty module and close the VB Editor.

Copy your source data into a cell on any worksheet (probably A1 would work
best)
With that cell selected, use Tools | Macro | Macros to select and [Run] the
code. The numbers will be split into 2 columns as requested starting right
below the source line. The source information will remain unaltered.

Sub SplitPairs()
'choose cell with list of numbers in it
'then run this macro from Tools | Macro | Macros
Const sepChar = " " ' single space
Dim sep1 As Long
Dim sep2 As Long
Dim group1 As Long
Dim group2 As Long
Dim onePair As String
Dim tempText As String

If IsEmpty(ActiveCell) Then
Exit Sub
End If
tempText = ActiveCell.Value
'make sure it terminates with a space
If Right(tempText, 1) <> sepChar Then
tempText = tempText & sepChar
End If
'make sure there aren't any
'multiple spaces in it
Do While InStr(tempText, " ")
tempText = Replace(tempText, " ", " ")
Loop
'begin the breakdown into pairs
Do While InStr(tempText, sepChar)
sep1 = InStr(tempText, sepChar)
sep2 = InStr(sep1 + 1, tempText, sepChar)
onePair = Left(tempText, sep2)
tempText = Right(tempText, Len(tempText) - sep2)
group1 = Val(Left(onePair, sep1))
group2 = Val(Right(onePair, Len(onePair) - sep1))
'put 1st group of numbers in column A
Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = group1
'put 2nd part of the pair in column B
Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = group2
Loop
End Sub

 

[Chip Pearson]

Where is your original list located? Is it in a single row on a
worksheet? All in one cell? Other?

If it is in a single row on a worksheet, use code like the following.
Change the lines marked with <<< to the appropriate values.

Sub AAA()
Dim ColNum As Long
Dim StartCol As Long
Dim EndCol As Long
Dim WS As Worksheet
Dim R As Range
Dim RowNum As Long

RowNum = 1 '<<< CHANGE TO ROW NUMBER OF DATA
StartCol = 1 '<<< CHANGE TO FIRST COLUMN OF DATA
Set WS = Worksheets("Sheet2") '<<< CHANGE SHEET NAME
Set R = WS.Range("A5") '<<< CHANGE TO WHERE COLUMNS SHOULD START
With WS
EndCol = .Cells(RowNum, .Columns.Count).End(xlToLeft).Column
End With
For ColNum = StartCol To EndCol Step 2
R(1, 1).Value = WS.Cells(RowNum, ColNum).Value
R(1, 2).Value = WS.Cells(RowNum, ColNum + 1).Value
Set R = R(2, 1)
Next ColNum
End Sub

If all the data is in a single cell, use code like the following.
Change the lines marked with <<< to the appropriate values.

Sub BBB()
Dim V As Variant
Dim R As Range
Dim DataCell As Range
Dim WS As Worksheet
Dim N As Long

Set WS = Worksheets("Sheet2") '<<< CHANGE
Set DataCell = WS.Range("A1") '<<< CHANGE
Set R = WS.Range("A5") '<<< CHANGE
V = Split(DataCell.Value, " ")
For N = LBound(V) To UBound(V) Step 2
R(1, 1) = V(N)
R(1, 2) = V(N + 1)
Set R = R(2, 1)
Next N
End Sub

If neither of these procs work, post back with considerably more
detail.

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)


On Tue, 24 Feb 2009 13:12:07 -0800, mt engineer <mt