Help with transposing 2000 rows of data into one column

[Tabanag]

I would like to transpose over 2000 rows of data into one column. Each row contains 300 columns of data, as an example:

Column1 Column2 Column3 Column4 .... Column300
T1000 T10006 T10200 T600
WU100 WE300
BT300 BT600 BT800

Results should show:
T1000
T10006
T10200
T600
WU100
WE300
BT300
BT600
BT800

Maybe a macro to transpose the first row, and then a repeat command?
Would appreciate any help please!!!

 

[Rick Rothstein]

How do you time the code Rick? Do you simply create a time stamp via VBA at the start and end of the code...

Yes.

 

[hiker95]

How do you time the code? Do you simply create a time stamp via VBA at the start and end of the code, or do you have some other way?

pvr928,

For one example, see (and, try) the two additional lines of code to my original macro:

Sub Tabanag()
' hiker95, 05/19/2016, ME942301
Dim w1 As Worksheet, w2 As Worksheet
Dim r As Long, lr As Long, c As Long, lc As Long, nr As Long
Application.ScreenUpdating = False

Dim tt As Single: tt = Timer

Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
Set w2 = Sheets("Sheet2")   '<-- you can change the sheet name here
w2.Columns(1).ClearContents
With w1
  lr = .Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  For r = 1 To lr
    If r = 1 Then
      nr = 1
    Else
      nr = w2.Cells(w2.Rows.Count, "A").End(xlUp).Row + 1
    End If
    w2.Cells(nr, 1).Resize(lc).Value = Application.Transpose(w1.Range(.Cells(r, 1), .Cells(r, lc)).Value)
  Next r
End With
With w2
  .Columns(1).AutoFit
  .Activate
End With
Application.ScreenUpdating = True

MsgBox "Code took " & Format(Timer - tt, "0.000 secs")

End Sub

 

[JoeMo]

On a reduced sample (9 columns by 2000 rows), the following code measures as 11 times faster than JoeMo's code and 6 times faster than hiker95's code...

Sub RowsToSingleLongColumn()
  Dim r As Long, c As Long, x As Long, Data As Variant, Result As Variant
  Data = Range("A1").CurrentRegion
  ReDim Result(1 To UBound(Data, 1) * UBound(Data, 2), 1 To 1)
  Columns("A").Insert
  For r = 1 To UBound(Data, 1)
    For c = 1 To UBound(Data, 2)
      If Len(Data(r, c)) Then
        x = x + 1
        Result(x, 1) = Data(r, c)
      Else
        Exit For
      End If
    Next
  Next
  Range("A1").Resize(UBound(Result)) = Result
End Sub

To put this in perspective, though, all codes executed in well under 1 second (although I do not know what affect on timing, other than they will go up, will occur when the columns are expanded out to 300)...

JoeMo: 0.66 seconds

hiker95: 0.36 seconds

mine: 0.06 seconds

No surprise on the timing, we know that processing everything in memory is quite fast.

The only problem I see with your code Rick is that if there are blanks embedded in the data your code will not output filled data cells in any portion of any row that lies beyond the first blank cell in the row.

 

[Rick Rothstein]

The only problem I see with your code Rick is that if there are blanks embedded in the data your code will not output filled data cells in any portion of any row that lies beyond the first blank cell in the row.

I used CurrentRegion because you did in your first posting (I figured you were clued into something that I might have missed having come to the thread late). That can, of course, be fixed if the OP ends up posting back that his data is not fully contiguous.

 

[JoeMo]

I used CurrentRegion because you did in your first posting (I figured you were clued into something that I might have missed having come to the thread late). That can, of course, be fixed if the OP ends up posting back that his data is not fully contiguous.

I don't mean not fully contiguous. Current region still encompasses the entire data range if there are some embedded blanks. You can leave the current region piece intact and fix the problem by simply removing the If - End If that hinges on Len(Data(r,c)) being true. Having done this, in a quick test, the speed of execution is virtually unaffected and for a full 2000 rows by 300 columns worth of data your modified code is still about 10X faster than mine.

 

[Rick Rothstein]

I don't mean not fully contiguous. Current region still encompasses the entire data range if there are some embedded blanks. You can leave the current region piece intact and fix the problem by simply removing the If - End If that hinges on Len(Data(r,c)) being true. Having done this, in a quick test, the speed of execution is virtually unaffected and for a full 2000 rows by 300 columns worth of data your modified code is still about 10X faster than mine.

Ah, embedded blank cells. I assumed from the layout shown in the OP's original post that there were no embedded blanks, so I figured once I hit a blank cell, I could short-circuit to the next row instead of examining potentially a lot of contiguous blank cells. Of course, your comment about removing the test for a blank cell indicates you knew that.... and, of course, your suggested fix would be correct as well.