Transpose multiple rows of column of data into one column

Question

I am trying to transpose multiple column of rows into one column

I understand this question has been asked, I have been trying to go by previous for a while but couldn't get it to work as needed. The problem I've had with previous examples is the output doesn't come in the format I need, it groups the numbers rather then doing it sequence.

Example array is:

1 1 1 
2 2 2
3 3 3
4 4 4

Output:

1
2
3
4
1
2
3
4
1
2
3
4

I know this size of data can be done in query editor in excel. But i need the sequence of data to be duplicated down 2300 lines. So my example array data would 2300 rows across which would take a lot of time to unpivot. Also the unpivot function doesn't merge the data into the order.

I've tried this example from this post but could not it get to work as needed. Get a function or sub undefined.

Sub Tester()

Dim p

'get the unpivoted data as a 2-D array
p = UnPivotData(Sheets("Sheet1").Range("A1").CurrentRegion, _
              3, False, False)
            
With Sheets("Sheet1").Range("H1")
    .CurrentRegion.ClearContents
    .Resize(UBound(p, 1), UBound(p, 2)).Value = p 'populate array to sheet
End With

'EDIT: alternative (slower) method to populate the sheet
'      from the pivoted dataset.  Might need to use this
'      if you have a large amount of data
'Dim r As Long, c As Long
'For r = 1 To Ubound(p, 1)
'For c = 1 To Ubound(p, 2)
'    Sheets("Sheet2").Cells(r, c).Value = p(r, c)
'Next c
'Next r

End Sub

I'm new to VBA and haven't explored it much, I am trying to find a example for this work.

Edit

Could the example be flexible to allow column array of 500+ rows rather then matching the range of what's in the example only?

Answer 1

Stack Columns

• Download the workbook from Google Drive (Down-arrow on the top-right).
• Adjust the values in the constants section.

Option Explicit

Sub stackColumns()
    
    Const sName As String = "Sheet1"
    Const sFirstColumn As String = "A"
    Const scCount As Long = 3
    
    Const dName As String = "Sheet1"
    Const dFirstCell As String = "H2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim srg As Range
    Dim srCount As Long
    
    With wb.Worksheets(sName).Range("A1").CurrentRegion.Columns(sFirstColumn)
        srCount = .Rows.Count - 1
        Set srg = .Resize(srCount, scCount).Offset(1)
    End With
    
    Dim Data As Variant: Data = srg.Value
    
    Dim Result As Variant: ReDim Result(1 To srCount * scCount, 1 To 1)
    
    Dim r As Long, c As Long, n As Long
    
    For c = 1 To scCount
        For r = 1 To srCount
            n = n + 1
            Result(n, 1) = Data(r, c)
        Next r
    Next c
        
    With wb.Worksheets(dName).Range(dFirstCell)
        .Resize(n).Value = Result
        .Resize(.Worksheet.Rows.Count - .Row - n + 1).Offset(n).ClearContents
    End With
        
End Sub

EDIT

Sub stackColumns2()
    
    Const sName As String = "Sheet1"
    Const sFirstColumn As String = "A"
    Const scCount As Long = 3
    
    Const dName As String = "Sheet1"
    Const dFirstCell As String = "H1"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim srg As Range: Set srg = wb.Worksheets(sName).Range("A1") _
        .CurrentRegion.Columns(sFirstColumn).Resize(, scCount)
    Dim srCount As Long: srCount = srg.Rows.Count
    
    Dim Data As Variant: Data = srg.Value
    
    Dim Result As Variant: ReDim Result(1 To srCount * scCount, 1 To 1)
    
    Dim r As Long, c As Long, n As Long
    
    For c = 1 To scCount
        For r = 1 To srCount
            n = n + 1
            Result(n, 1) = Data(r, c)
        Next r
    Next c
        
    With wb.Worksheets(dName).Range(dFirstCell)
        .Resize(n).Value = Result
        .Resize(.Worksheet.Rows.Count - .Row - n + 1).Offset(n).ClearContents
    End With
        
End Sub

Answer 2

To transform multiple columns into a single column, and maintain the column order instead of converting to row order, merely transpose the table before unpivoting.

eg:

let
    Source = Excel.CurrentWorkbook(){[Name="Table2"]}[Content],
    #"Transposed Table" = Table.Transpose(Source),
    #"Unpivoted Only Selected Columns" = Table.UnpivotOtherColumns(#"Transposed Table", {}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Only Selected Columns",{"Attribute"})
in
    #"Removed Columns"

On a matrix of 2500 columns * 100 rows, this query completed in less than one second.