Stacking Columns in One Excel Sheet

[Dag2]

Hi,

I want to stack columns B to F of the following Excel MiniSheet below column A:

Keywords_Search_Klemens.xlsm
	A	B	C	D	E	F
1	aa1	bb1	cc1	dd1	ee1	ff1
2	aa2	bb2	cc2		ee2	ff2
3	aa3	bb3	cc3		ee3	ff3
4	aa4		cc4		ee4	ff4
5	aa5		cc5		ee5	ff5
6	aa6		cc6		ee6	ff6
7	aa7				ee7	ff7
8	aa8					ff8
9	aa9					ff9
10	aa10					ff10
11	aa11
12	aa12
13	aa13
Sheet1

This is only a small fraction of the Data. In the real dataset I would need it to stack columns B to ABP of varying length (column A is actually the longest with a range from A1 to A89) under column A. I saw someone from a different thread perform a LET-function, but I couldn't get it to work.

Help is very much appreciated!

Best regards and thank you in advance!
Klemens

 

[arthurbr]

You can also do this with Power Query

 

[Georgiboy]

Maybe:

Book1
	A	B	C	D	E	F
1	aa1	bb1	cc1	dd1	ee1	ff1
2	aa2	bb2	cc2		ee2	ff2
3	aa3	bb3	cc3		ee3	ff3
4	aa4		cc4		ee4	ff4
5	aa5		cc5		ee5	ff5
6	aa6		cc6		ee6	ff6
7	aa7				ee7	ff7
8	aa8					ff8
9	aa9					ff9
10	aa10					ff10
11	aa11
12	aa12
13	aa13
14	bb1
15	bb2
16	bb3
17	cc1
18	cc2
19	cc3
20	cc4
21	cc5
22	cc6
23	dd1
24	ee1
25	ee2
26	ee3
27	ee4
28	ee5
29	ee6
30	ee7
31	ff1
32	ff2
33	ff3
34	ff4
35	ff5
36	ff6
37	ff7
38	ff8
39	ff9
40	ff10
Sheet1

Cell Formulas
Range	Formula
A14:A40	A14	=TOCOL(TRANSPOSE(B1:F10),1)
Dynamic array formulas.

 

[Fluff]

Another (similar) option

Fluff.xlsm
	A	B	C	D	E	F
1	aa1	bb1	cc1	dd1	ee1	ff1
2	aa2	bb2	cc2		ee2	ff2
3	aa3	bb3	cc3		ee3	ff3
4	aa4		cc4		ee4	ff4
5	aa5		cc5		ee5	ff5
6	aa6		cc6		ee6	ff6
7	aa7				ee7	ff7
8	aa8					ff8
9	aa9					ff9
10	aa10					ff10
11	aa11
12	aa12
13	aa13
14	bb1
15	bb2
16	bb3
17	cc1
18	cc2
19	cc3
20	cc4
21	cc5
22	cc6
23	dd1
24	ee1
25	ee2
26	ee3
27	ee4
28	ee5
29	ee6
30	ee7
31	ff1
32	ff2
33	ff3
34	ff4
35	ff5
36	ff6
37	ff7
38	ff8
39	ff9
40	ff10
Master

Cell Formulas
Range	Formula
A14:A40	A14	=TOCOL(B1:F13,1,1)
Dynamic array formulas.

 

[Dag2]

Thank you so much guys!
In the end I stumbled across this solution, which also worked great for me, so I thought I share it:

Sub Stack_cols()
 
    On Error GoTo Stack_cols_Error
     
    Dim lNoofRows As Long, lNoofCols As Long
    Dim lLoopCounter As Long, lCountRows As Long
    Dim sNewShtName As String
    Dim shtOrg As Worksheet, shtNew As Worksheet
     
    'Turn off the screen update to make macro run faster
    Application.ScreenUpdating = False
    'Ask for a new sheet name, if not provided use newsht
    sNewShtName = InputBox("Enter the new worksheet name", "Enter name", "newsht")
    'Set a sheet variable for the sheet where the data resides
    Set shtOrg = ActiveSheet
    'Add a new worksheet, rename it and set it to a variable
    If Not SheetExists(sNewShtName) Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sNewShtName
        Set shtNew = Worksheets(sNewShtName)
    Else
        MsgBox "Worksheet name exists. Try again", vbInformation, "Sheet Exists"
        Exit Sub
    End If
     
    With shtOrg
        'Get the last column number
        'Replace .Range("IV1") with .Range("XFD1") for Excel 2007
        lNoofCols = .Range("XFD1").End(xlToLeft).Column
        'Start a loop to copy and paste data from the first column to the last column
        For lLoopCounter = 1 To lNoofCols
        'Count the number of rows in the looping column
            'Replace .Cells(65536, lLoopCounter) with .Cells(1048576, lLoopCounter) for Excel 2007
            lNoofRows = .Cells(1048576, lLoopCounter).End(xlUp).Row
            .Range(.Cells(1, lLoopCounter), .Cells(lNoofRows, lLoopCounter)).Copy Destination:=shtNew.Range(shtNew.Cells(lCountRows + 1, 1), shtNew.Cells(lCountRows + lNoofRows, 1))
            'count the number of rows in the new worksheet
            lCountRows = lCountRows + lNoofRows
        Next lLoopCounter
    End With
     
    On Error GoTo 0
SmoothExit_Stack_cols:
        Application.ScreenUpdating = True
        Exit Sub
     
Stack_cols_Error:
' if this gives you an error, make sure that there an ampersand (&) sign, rather than the &amp literal string. the code formatting is an issue
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub:Stack_cols"
    Resume SmoothExit_Stack_cols
End Sub
'Check if a worksheet exists or not
Public Function SheetExists(sShtName As String) As Boolean
    On Error Resume Next
     
    Dim wsSheet As Worksheet, bResult As Boolean
    bResult = False
    Set wsSheet = Sheets(sShtName)
     
    On Error GoTo 0
    If Not wsSheet Is Nothing Then
        bResult = True
    End If
    SheetExists = bResult
End Function

 

[alansidman]

an alternative is with Power Query to unpivot your data

let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(Source, {}, "Attribute", "Value")
in
    #"Unpivoted Columns"

 

[Georgiboy]

Using @Fluff formula and the evaluate function you could make the VBA to do something similar:

Sub test()
    Dim rng As Range, nWS As Worksheet
    
    Set rng = Application.InputBox("Select range to transpose", Type:=8)
    Set nWS = Sheets.Add(, Sheets(Sheets.Count))
    nWS.Range("A1").Resize(Application.CountA(rng)) = Evaluate("TOCOL(" & rng.Address(, , , True) & ",1,1)")
End Sub