How to transpose different sized rows into one column

Question

I'm pretty new to Excel VBA and I am currently trying to take data from multiple rows and transpose it into a single column. I know where the first cell of the data will begin, but that's all I know. Each row of data is a different sized row, and there can be a varying number of columns also.

So my current method is using a sort of transpose where I just select a very large range (in hopes that it captures all my data) and then transposing it. It does work, albeit pretty slow, and it also includes all the blanks in my range also.

Sub transpose()
    Dim InputRange As Range
    Dim OutputCell As Range

    Set InputRange = Sheets("Sheet1").Range("P1:AC100")

    'output will begin at this cell and continue down.
    Set OutputCell = Sheets("Sheet1").Range("A1")   

    For Each cll In InputRange
        OutputCell.Value = cll.Value
        Set OutputCell = OutputCell.Offset(1, 0)
    Next
End Sub

The current method isn't the worst, but I'm sure there are better methods that are quicker and ignore blanks. I'm not sure if an actual transpose is the best way, or perhaps using some sort of loop method. The data is usually contained within 200 rows, and 10 columns if that helps in deciding a method (maybe looping might be quick enough). Any help would be appreciated!

---

Edit

I have found a method of ignoring the blanks:

For Each cll In InputRange
  If Not IsEmpty(cll.Value) Then
    OutputCell.Value = cll.Value
    Set OutputCell = OutputCell.Offset(1, 0)
  End If
Next

Answer 1

This 'snake' method works fine for me.

Sub Snake()
   Dim N As Long, i As Long, K As Long, j As Long
   Dim sh1 As Worksheet, sh2 As Worksheet
   K = 1
   Set sh1 = Sheets("Sheet1")
   Set sh2 = Sheets("Sheet2")
   N = sh1.Cells(Rows.Count, "A").End(xlUp).Row

   For i = 1 To N
      For j = 1 To Columns.Count
         If sh1.Cells(i, j) <> "" Then
            sh2.Cells(K, 1).Value = sh1.Cells(i, j).Value
            K = K + 1
         Else
            Exit For
         End If
      Next j
   Next i
End Sub

Before:

After:

Answer 2

Option Explicit

Public Sub Range_2_Column_Skip_VbNUllString()
' Test Covered
'
    Range_2_Column Cells(1, 1).CurrentRegion, _
            Cells(1, 5), vbNullString

End Sub

Public Function Range_2_Column( _
        ByVal r_Sour As Range, _
        cell_Dest As Range, _
        ByVal sKip As String)
' Test Covered

    A2_2_Range A2_From_Coll( _
            Coll_From_A2_Skip( _
            A2_From_Range(r_Sour), sKip)), cell_Dest

End Function

Public Sub A2_2_Range( _
        a2() As Variant, _
        cell As Range)
' Test Covered
    cell.Resize( _
            UBound(a2), UBound(a2, 2)).Value = _
            a2

End Sub

Public Function A2_From_Range( _
        ByVal r As Range) _
        As Variant()
' Test Covered
'
    A2_From_Range = r.Value

End Function

Public Function Coll_From_A2_Skip( _
        a2() As Variant, _
        ByVal sKip As String) _
        As Collection
' Test Covered
'
    Dim coll As New Collection

    Dim v As Variant

    For Each v In a2
        If v <> sKip Then
            coll.Add v
        End If
    Next

    Set Coll_From_A2_Skip = coll

End Function

Public Function A2_From_Coll( _
        ByVal coll As Collection) _
        As Variant()
' Test Covered
'
    ReDim a2(1 To coll.Count, 1 To 1) As Variant

    Dim v As Variant
    Dim iCount As Long
    iCount = 1

    For Each v In coll
        a2(iCount, 1) = v
        iCount = iCount + 1
    Next

    A2_From_Coll = a2

End Function

Answer 3

One thing you could do is instead of looping the entire range just loop the SpecialCells.

Depending on what the content is of your inputRange then you can choose which XlCellType to use.

If it is just hardcoded values then xlCellTypeConstants would work fine for you. Alternatively, you might be looking at formulas, in which case you would want to use xlCellTypeFormulas.You can also do a Union if you need both.

Here is an example using just xlCellTypeConstants

Sub transposes()

    ' Example just for hardcoded data
    Dim inputRange As Range
    Set inputRange = Sheets("Sheet1").Range("P1:AC100").SpecialCells(xlCellTypeConstants)

    Dim outputCell As Range
    Set outputCell = Sheets("Sheet1").Range("A1")

    Dim cell As Range
    For Each cell In inputRange
        Dim offset As Long
        outputCell.offset(offset).Value = cell.Value
        offset = offset + 1
    Next cell

End Sub