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" & row).Delete Shift:=xlUp     Application.StatusBar = "Progress: " & row & " of z: " & Format((z - row) / z, "Percent")    DoEvents      End If  Next  Application.StatusBar = False Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic   End Sub 

Converting a range in excel to a single column with excel vba

Replay

4-5 hours is ridiculous

4-5 hours with ScreenUpdating, Events, & 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" & row) '/ add the first range
        Else
            Set rowsToBeDeleted = Union(rowsToBeDeleted, Range("A" & 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.)

Category: performance Time: 2016-07-28 Views: 0

Related post

iOS development

Android development

Python development

JAVA development

Development language

PHP development

Ruby development

search

Front-end development

Database

development tools

Open Platform

Javascript development

.NET development

cloud computing

server

Copyright (C) avrocks.com, All Rights Reserved.

processed in 0.176 (s). 12 q(s)