Converting a range in excel to a single column with excel vba I am very new to coding and know only the basics.  The first part of this code is running fine.  It converts a range of values to a single column.  However, with my data set the rows of data step down, as shown in the sample data set below, so that when they are converted to a single column there are large gaps of 0 values in the column.  I added a portion of code to the end to look at each cell in the column and delete any 0 values.  The problem is this code takes around 4-5 hours to run.  I am hoping there is a better way to write the code to speed up the processing time.

Any help is appreciated!

Sub CombineColumns()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim rng As Range
Dim iCol As Long
Dim lastCell As Long
Dim k As Long

k = 484
'set K equal to the number of data points that created the range


Set rng = ActiveCell.CurrentRegion
lastCell = rng.Columns(1).Rows.Count + 1

For iCol = 2 To rng.Columns.Count
    Range(Cells(1, iCol), Cells(rng.Columns(iCol).Rows.Count, iCol)).Cut
    ActiveSheet.Paste Destination:=Cells(lastCell, 1)
    lastCell = lastCell + rng.Columns(iCol).Rows.Count

Next iCol
Dim z As Long
Dim m As Long


z = k ^ 2

For row = z To 1 Step -1
    If Cells(row, 1) = 0 Then
    Range("A" &amp; row).Delete Shift:=xlUp

   Application.StatusBar = "Progress: " &amp; row &amp; " of z: " &amp; Format((z - row) / z, "Percent")
   DoEvents

    End If

Next

Application.StatusBar = False
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic


End Sub
4-5 hours is ridiculous

4-5 hours with ScreenUpdating, Events, &amp; Calculation disabled is even more so.

What you've discovered here is that Excel is very slow at inserting/deleting columns/rows when you have large amounts of data in a Worksheet.

and you're doing it up to 235,000 times.



Delete everything in a single operation

What we're going to do here is loop through Ranges and, as we go, add all the Ranges-to-be-deleted to one master Range using the Union() function.

Then, at the end, delete the entire master range in one go:

Dim rowsToBeDeleted As Range '/ our master delete range

For row = Z To 1 Step -1

    If Cells(row, 1) = 0 Then

        If rowsToBeDeleted is Nothing Then '/ check if any ranges have been added yet
            Set rowsToBeDeleted = Range("A" &amp; row) '/ add the first range
        Else
            Set rowsToBeDeleted = Union(rowsToBeDeleted, Range("A" &amp; row)) '/ add the new range to the existing ones
        End If

    End If

Next row

If Not rowsToBeDeleted Is Nothing Then '/ check that we found anything to delete
    rowsToBeDeleted.EntireRow.Delete
End If


I suspect that this change alone will take your runtime from hours to minutes.

(Just as an aside, worth noting that a Range object can only have up to 1,048,576 range areas. So if you ever get up to more than 1,024^2, you'll have to check against it.)