Stack without VStack

topi1

Board Regular
Joined
Aug 6, 2014
Messages
161
Office Version
  1. 2010
Hi,
I am using the following code to stack multiple columns into one. Why is the macro getting stuck in the Second last line "Next"? I use Excel 2010.
Thank you.
VBA Code:
Sub Stack_New()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long
    For i = 2 To 800
        Lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Lastrowa = Cells(Rows.Count, i).End(xlUp).Row
        Range(Cells(1, i), Cells(Lastrowa, i)).Copy Cells(Lastrow, 1)
    Next
Application.ScreenUpdating = True
   
End Sub
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Can you be more specific about what "getting stuck" means here? What are you expecting this Sub to do, and what is it doing instead? Are you getting an error? Is the code hanging?

The only thing I notice here is that if a column is blank, Lastrowa will be 1 and you will still waste time copying blank cells. Is that what is intended?
 
Upvote 0
I tried your macro with some sample data, and it worked for me. I suspect doing so many copies in a loop might be the problem though, I only did 19 columns. Do you need to copy the cell formatting though? If you just want to stack the values, then this macro will be much faster, and I suspect won't have your problem with getting stuck. I assume you'll have a value in A1.

VBA Code:
Sub Stack_New2()
Dim ur As Variant, r As Long, c As Long, c2 As Long, op() As Variant

    ur = ActiveSheet.UsedRange.Value
    ReDim op(1 To UBound(ur) * 800, 1 To 1)
    c2 = 0
    For c = 1 To IIf(UBound(ur, 2) < 800, UBound(ur, 2), 800)
        For r = 1 To UBound(ur)
            If ur(r, c) = "" Then Exit For
            c2 = c2 + 1
            op(c2, 1) = ur(r, c)
        Next r
    Next c
    
    Range("A1").Resize(c2).Value = op
    
End Sub
 
Upvote 0
Solution
Can you be more specific about what "getting stuck" means here? What are you expecting this Sub to do, and what is it doing instead? Are you getting an error? Is the code hanging?

The only thing I notice here is that if a column is blank, Lastrowa will be 1 and you will still waste time copying blank cells. Is that what is intended?
Sorry, I should have been clearer. I am trying to stack rows C and onwards into the Row A. The number of columns I need to include to the right of C will increase as months pass by. My best guess is that there won't be any empty cells between filled cells in any of the rows. Each row will have variable number of contiguous data. I think there wont be any empty columns between filled columns. I ran Eric W's code and it worked great. Thank you for your follow up.
 
Upvote 0
I tried your macro with some sample data, and it worked for me. I suspect doing so many copies in a loop might be the problem though, I only did 19 columns. Do you need to copy the cell formatting though? If you just want to stack the values, then this macro will be much faster, and I suspect won't have your problem with getting stuck. I assume you'll have a value in A1.

VBA Code:
Sub Stack_New2()
Dim ur As Variant, r As Long, c As Long, c2 As Long, op() As Variant

    ur = ActiveSheet.UsedRange.Value
    ReDim op(1 To UBound(ur) * 800, 1 To 1)
    c2 = 0
    For c = 1 To IIf(UBound(ur, 2) < 800, UBound(ur, 2), 800)
        For r = 1 To UBound(ur)
            If ur(r, c) = "" Then Exit For
            c2 = c2 + 1
            op(c2, 1) = ur(r, c)
        Next r
    Next c
   
    Range("A1").Resize(c2).Value = op
   
End Sub
Thank you @Eric W. It did the trick. Appreciate it!
 
Upvote 0

Forum statistics

Threads
1,215,069
Messages
6,122,958
Members
449,096
Latest member
Anshu121

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top