Stack Columns of Data on one column
I have modified this code for better explanation and error handling (includes a function to check if a worksheet exists or not). To run this code follow these steps:
1. Insert a new module in your workbook,
2. Copy and paste this code,
3. Go back to worksheet with data in it,
4. Press Alt + F8 to bring the macro window
5. Select this procedure and hit run
6. Enter the new worksheet name in the input box
7. If everything went well, you should have a new worksheet with all the data from original worksheet in one column with the column headers. See the screen shots for example.
Before stacking-the original data:

After stacking:

Here’s the code:
Option Explicit 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("IV1").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(65536, 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: 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
![[CiteULike]](http://nandeshwar.info/wp-content/plugins/bookmarkify/citeulike.png)
![[del.icio.us]](http://nandeshwar.info/wp-content/plugins/bookmarkify/delicious.png)
![[Digg]](http://nandeshwar.info/wp-content/plugins/bookmarkify/digg.png)
![[Facebook]](http://nandeshwar.info/wp-content/plugins/bookmarkify/facebook.png)
![[Furl]](http://nandeshwar.info/wp-content/plugins/bookmarkify/furl.png)
![[Google]](http://nandeshwar.info/wp-content/plugins/bookmarkify/google.png)
![[Reddit]](http://nandeshwar.info/wp-content/plugins/bookmarkify/reddit.png)
![[Slashdot]](http://nandeshwar.info/wp-content/plugins/bookmarkify/slashdot.png)
![[StumbleUpon]](http://nandeshwar.info/wp-content/plugins/bookmarkify/stumbleupon.png)
![[Technorati]](http://nandeshwar.info/wp-content/plugins/bookmarkify/technorati.png)
![[Twitter]](http://nandeshwar.info/wp-content/plugins/bookmarkify/twitter.png)
![[Email]](http://nandeshwar.info/wp-content/plugins/bookmarkify/email.png)
did the trick, thanks you genius! JAmes UK)
could you perhaps show me how to implement your code? I’m having trouble getting results when running it. Thanks!
EfficienC:
I’ve modified the code. I hope that this offers more explanation.
Works PERFECTLY!!!! This just save me HOURS and HOURS of manual work. Thank you! – dub3
Any chance this can be translated for Excel 2007? This seems like exactly the thing to save tons of time in excel.
Thanks
Edward
Edward,
I’ve modified the code, and put two comments:
‘Replace .Range(“IV1″) with .Range(“XFD1″) for Excel 2007
lNoofCols = .Range(“IV1″).End(xlToLeft).Column
‘Replace .Cells(65536, lLoopCounter) with .Cells(1048576, lLoopCounter) for Excel 2007
lNoofRows = .Cells(65536, lLoopCounter).End(xlUp).Row
You have to make two changes to make this work for 2007. First, change the last column from IV to XFD. Second, change the number of rows from 65536 to 1048576.
Much Appreciated!
In order for this to be even more effective, you could stack into two columns, with the first column repeating the header information for each stacked column. E.g.
A 1
A 2
A 3
B 1
B 2
B 3
Thanks!
Does anyone know how to unstack a column? Say I have similar categories of information for 9 groups of 11 cells, all stacked in one column. I am looking to create a table (9×11)… I would very much appreciate your insights!
thankyou so much…saved me a whole lot of work
This is close to what I am looking for. How can I stack groups of columns? Like G groups of C columns? Or 10 Groups of 3 columns stacked in one group of 3 columns? It needs to be variable, because sometimes it might be 25 groups of 4 columns, etc. I can send an example of the data I have and how I need it to be arrange.
Dan
dmiech@aol.com
EXCELLENT. WORKED VERY WELL.
(took me a while, i’m not used to Macros, but I realized that when you copy this code, the ” and the ‘ don’t copy correctly. So make sure you replace those)
@darhay,
I’m glad that it worked for you, darhay. I’m sorry that the quotes come out wrong. Those single quotes got messed up when I transferred my posts from blogger to wordpress. I will see if I can replace them correctly.
that was so easy!!!!
thank you so much for putting this on the web.
Absolutely brilliant.
Thanks….saved me loads of time.