import simple data & re-arrange it

[JohnB]

I have a text file of 40 integers in several rows, separated by commas.
I created an Excel query. I click on my query, it opens Excel, delimits
the import, and pastes this into a sheet:

1 2 3 4 5 6
7 8 9 10 11 12
13 14 15 16 17 18
19 20 21 22 23 24
25 26 27 28 29 30
31 32 33 34 36 36
37 38 39 40

I wish to turn this into a single column:

1
2
..
..
..
40

I could not find a way to form one column while importing this data, that
would have been ideal to do. So, I record a macro, cut row 2, paste it
to the right of row 1, cut row 3, paste it to the right again, until I
have 1 row. I then copy the row, paste special & transpose it to a
column.

The macro itself does not record the "pastes"! Here it is:

Sub Columnize()
'
' Columnize Macro
'
' Keyboard Shortcut: Ctrl+r
'

Range("A2:F2").Select
Selection.Cut
Range("A3:F3").Select
Selection.Cut
Range("A4:F4").Select
Selection.Cut
Range("A5:F5").Select
Selection.Cut
Range("A6:F6").Select
Selection.Cut
Range("A77").Select
Selection.Cut
Rows("1:1").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone,
SkipBlanks:=False _
, Transpose:=True
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End Sub




All it does is cut the first row each time I run it.

I've been experimenting for hours trying to automate this seemingly easy
function, and learn how to better create macros on my own. I find this
very frustrating

Advice is really appreciated!

thanks,

John

 

[Tom Ogilvy]

Your macro cuts each line, but never pastes the line.

Sub Columnize()
'
' Columnize Macro
'
' Keyboard Shortcut: Ctrl+r
'

Range("A2:F2").Select
Selection.Cut
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste
Range("A3:F3").Select
Selection.Cut
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste
Range("A4:F4").Select
Selection.Cut
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste
Range("A5:F5").Select
Selection.Cut
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste
Range("A6:F6").Select
Selection.Cut
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste
Range("A77").Select
Selection.Cut
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End Sub

Another way
Sub Columnize1()
Dim rng As Range, varr As Variant
Dim i As Long, j As Long, k As Long
Set rng = Range("A1").CurrentRegion
varr = rng.Value
rng.ClearContents
i = 1
For j = LBound(varr, 1) To UBound(varr, 1)
For k = LBound(varr, 2) To UBound(varr, 2)
If Not IsEmpty(varr(j, k)) Then
Range("A1")(i, 1).Value = varr(j, k)
i = i + 1
End If
Next
Next
End Sub

 

[Gord Dibben]

John

Sub c()
Dim rngIn As Range, rngOut As Range, i As Long
Set rngIn = Range("A1:F7")
Set rngOut = Range("G1")
For i = 1 To rngIn.Rows.Count
rngIn.Rows(i).Copy
rngOut(1 + (rngIn.Columns.Count) * (i - 1)).PasteSpecial _
Transpose:=True
Next
Application.CutCopyMode = False
Range("A:F").Delete
End Sub

Gord Dibben Excel MVP

 

[JohnB]

John

Sub c()
Dim rngIn As Range, rngOut As Range, i As Long
Set rngIn = Range("A1:F7")
Set rngOut = Range("G1")
For i = 1 To rngIn.Rows.Count
rngIn.Rows(i).Copy
rngOut(1 + (rngIn.Columns.Count) * (i - 1)).PasteSpecial _
Transpose:=True
Next
Application.CutCopyMode = False
Range("A:F").Delete
End Sub

Gord Dibben Excel MVP

Thank you both!!

Now I can get these done faster, and spend my time analyzing the data

John

 

[Dana DeLouis]

Just another technique. This assumes your table of data is D1:I7, with
output starting at A1. I did not account for Empty cells.

Sub Demo()
Dim v, vOut()
Dim nr As Long '# of Rows
Dim nc As Long '# of Columns
Dim p As Long ' Pointer

v = [D1].CurrentRegion
nr = UBound(v, 1)
nc = UBound(v, 2)

ReDim vOut(1 To nr * nc, 1 To 1)

For p = 0 To (nr * nc) - 1
vOut(p + 1, 1) = v(1 + p \ nc, 1 + (p Mod nc))
Next
[A1].Resize(nr * nc) = vOut
End Sub

HTH
Dana DeLouis

 

[JohnB]

Thanks for your time, I am appreciative!

john