Move Data to One Column

[TerryP]

I have data in multiple columns like this :



<pre>
20707168 20933238 20476750 20562404
21016254 20921261 20560321 20930943
21016301 21084700 20934594 21337734
21342117 21328617 21349354 21215562
20854831 21112280 21354623 20854998
20856094 20856680 21131627 21022690
21335639 21358864 20976123 20982292
21277545 21174476 21288204 21204508
21357727 21040620 20856253 21304184
20980329 21268373 21049644 20856612
21202994 21274060 21364011 21032761
21349318 21336338 21174662 21337243
20929325 20560780 20856182 20562604
20563105 21334453 20964299 20907247
20855986 20551083 20538507 20915118
20969553 21169459 21032727 21171546
21096805 21097044 21267142 21128912
21226288 21292704 21309776 21311756
20975721 20941514 20979821 20942369
</pre>


I'd like to move all data to one single column (like column #1)

Can someone help me out with a VBA macro ?

Much appreciated

[RonMcK]

TerryP,

Your request is similar to one we (on VBAX) worked on several weeks ago (as I dimly recall).

Copy and Paste the folloiwng code into a Module in the VBE. Highlight the cell or cells containing your table (or array) of numbers, then, invoke the macro. You can do this from Tools > Macro > Macros and select MoveNumsTo1Column and Run it. Or, open the VBA IDE (aka VBE), navigate to the module for MoveNumsTo1Column and use the toolbar or command buttons to step or run the code.

Option Explicit

Public Sub MoveNumsTo1Column()
Dim cell As Range
Dim tmp As Variant
Dim myArry() As String
Dim ArrySiz As Long
Dim NewArrySiz As Long
ArrySiz = 100
NewArrySiz = ArrySiz
Dim i As Long
Dim j As Long
Dim ii As Long
ReDim myArry(ArrySiz, 4)

j = 0
For Each cell In Selection

If cell.Value <> "" Then
'// Uncomment this line if running on a Mac box else comment out
' tmp = str_split(cell.Value, " ")
'// Uncomment this line if running on a Windows box else comment out
tmp = Split(cell.Value, " ")

For i = LBound(tmp) To UBound(tmp)
If InStr(1, tmp(i), "pre", vbBinaryCompare) Then
If i <> UBound(tmp) Then
For ii = LBound(tmp) + 1 To UBound(tmp)
tmp(ii - 1) = tmp(ii)
tmp(ii) = ""
Next ii
Else
tmp(ii) = ""
End If
End If
myArry(j, 4) = tmp(i)
j = j + 1
If j > NewArrySiz Then
NewArrySiz = NewArrySiz + ArrySiz
ReDim Preserve myArry(NewArrySiz, 4)
End If

Next i
End If
Next cell

If myArry(1, 4) <> "" Then
For i = LBound(myArry) To UBound(myArry)

Selection.Cells(i - LBound(myArry) + 1, 1).Value = myArry(i, 4)
Next i
End If
End Sub

'str_split()' is a private function that I use on my Mac to emulate the 'split' function that lives in MS Excel on Windows. As I recall Bob (XLD) and Malcolm (MDMackillop) and probably several others helped with creating this originally.

HTH,