Copying visible/filtered rows efficiently in excel

Question

I am working with some very large datasets (various sheets with 65K+ rows and many columns each). I am trying to write some code to copy filtered data from one sheet to a new empty sheet as fast as possible, but have not had much success so far.

I can include the rest of the code by request, but all it does is calculates the source and destination ranges (srcRange and destRange). The time taken to calculate these is negligible. The vast majority of the time is being spent on this line (4 minutes 50 seconds to be precise):

srcRange.Rows.SpecialCells(xlCellTypeVisible).Copy Destination:=destRange

Additionally I've tried this:

destRange.Value = srcRange.Rows.SpecialCells(xlCellTypeVisible).Value

But it doesn't work properly when there's a filter.

Function FastCopy(srcSheet As String, srcCol As String, destSheet As String, destCol As String)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim srcRange As Range
    Dim destRange As Range

    Set srcRange = GetColumnRangeByHeaderName(srcSheet, srcCol, -1)
    Set destRange = GetColumnRangeByHeaderName(destSheet, destCol, srcRange.Rows.Count)


    'destRange.Value = srcRange.Rows.SpecialCells(xlCellTypeVisible).Value

    srcRange.Rows.SpecialCells(xlCellTypeVisible).Copy Destination:=destRange

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual
End Function

This is a slow, dual core machine with 2GB of RAM running excel 2010. Results will obviously vary on a faster machine.

@mehow `srcRange.Address=$AH$2:$AH$53639` `destRange.Address=$F$2:$F$53638` — David, Apr 01 '14 at 14:20
can you not copy the entire range (no filter) using arrays like [**THIS**](http://stackoverflow.com/questions/18481330/2-dimensional-array-from-range/18481730#18481730) and then simply apply the same filter and remove *not visible* cells? — , Apr 01 '14 at 14:27
@mehow Why? The filter is dependent on various other columns. That would mean I would either need to copy those columns too, adding unnecessary overhead, or have to index/match 53K rows columns to get a value to filter against. Seems like it won't be efficient in either case. — David, Apr 01 '14 at 14:36
@David did you apply the filter via code? What are the criteria? — , Apr 01 '14 at 14:40
@mehow It's a calculated field depending on other fields which were inserted to the table by code. — David, Apr 01 '14 at 14:43
@David Great, see my answer. If you could provide the time it took you to run it that would be great I am very curious — , Apr 01 '14 at 14:51
possible duplicate of [How to copy a line in excel using a specific word and pasting to another excel sheet?](http://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s) — Siddharth Rout, Apr 01 '14 at 18:27
This is about efficiency. ..not a duplicate of that one IMO. mehow ill try to give you timings later. — David, Apr 01 '14 at 21:34

score 5 · Accepted Answer · edited Apr 01 '14 at 14:26

Try something like this to work with filtered ranges. You're on the right track, the .Copy method is expensive and simply writing values from range to range should be much faster, however as you observe, this doesn't work when a range is filtered. When the range is filtered, you need to iterate the .Areas in the range's .SpecialCells:

Sub Test()
Dim rng As Range
Dim subRng As Range
Dim destRng As Range


Set destRng = Range("A10")

Set rng = Range("A1:B8").SpecialCells(xlCellTypeVisible)

For Each subRng In rng.Areas
    Set destRng = destRng.Resize(subRng.Rows.Count, subRng.Columns.Count)
    destRng.Value = subRng.Value
    Set destRng = destRng.Cells(destRng.Rows.Count, 1).Resize(1, 1).Offset(1, 0)
Next

End Sub

Modified for your purposes, but untested:

Function FastCopy(srcSheet As String, srcCol As String, destSheet As String, destCol As String)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim srcRange As Range
    Dim destRange As Range
    Dim subRng As Range

    Set srcRange = GetColumnRangeByHeaderName(srcSheet, srcCol, -1)
    Set destRange = GetColumnRangeByHeaderName(destSheet, destCol, srcRange.Rows.Count)

    For Each subRng In srcRange.Areas
        Set destRng = destRng.Resize(subRng.Rows.Count, subRng.Columns.Count)
        destRng.Value = subRng.Value
        Set destRng = destRng.Cells(destRng.Rows.Count, 1).Resize(1, 1).Offset(1, 0)
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual
End Function

Runtime: 121 seconds. That's a vast improvement, but can we cut it down a bit more? — David, Apr 01 '14 at 14:38
If this is still taking 121s, it seems like @mehow's answer is much faster. — David Zemens, Apr 01 '14 at 15:12
I have sorted the source column I'm filtering on. There are now just two areas. Runtime: 0.40625s. Perfect! — David, Apr 01 '14 at 15:15
+1. Sorting would tend to minimize the number of Areas, which should speed it up. — David Zemens, Apr 01 '14 at 15:19

score 2 · Answer 2 · 2014-04-01T14:57:07.553

Simplest copying (no filter)

Range("F1:F53639").Value = Range("A1:A53639").Value

To expand on my comment

Sub Main()
Application.ScreenUpdating = False
    ' paste the Range into an array
    Dim arr
    arr = Range("$A$1:$A$53639").Value

    ' fill the range based on the array
    Range("$F$1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr


    ' apply the same filter to your copied range as the original range
        '+  i don't know how you have applied your filter but just re-apply it to column F

    ' and delete the invisible cells
    ' unfortunately there is no xlCellTypeHidden or xlCelltypeInvisible hehe so you have to iterate
    Dim i As Long
    For i = Range("F" & Rows.Count).End(xlUp).Row To 1 Step -1
        If (Range("F" & i).EntireRow.Hidden) Then Range("F" & i).Delete
        ' or Range("F" & i).EntireRow.Delete
    Next i
Application.ScreenUpdating = True
End Sub

If you could provide the time it took you to run it that would be great I am very curious

I just ran this code on 53639 rows and it took less than 1 second

Sub Main()
Application.ScreenUpdating = False

    Dim tNow As Date
    tNow = Now

    ' paste the Range into an array
    Dim arr
    arr = Range("$A$1:$A$53639").Value

    ' fill the range based on the array
    Range("$F$1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

    ' apply the same filter to your copied range as the original range
    ActiveSheet.Range("$F$1:$F$53640").AutoFilter Field:=1, Criteria1:="a"

    ' and delete the invisible cells
    ' unfortunately there is no xlCellTypeHidden or xlCelltypeInvisible hehe so you have to iterate
    Dim i As Long
    For i = Range("F" & Rows.Count).End(xlUp).Row To 1 Step -1
        If (Range("F" & i).EntireRow.Hidden = True) Then
            Range("F" & i).Delete
        End If
    Next i

    Debug.Print DateDiff("s", tNow, Now)
Application.ScreenUpdating = True
End Sub

Woah.... copying all that data without any filters takes less than two seconds! I'm going to try to apply the filter from that table. Edit: Strangely, it seems that if I use srcRange.Value = destRange.Value, at row 24,354 downwards it will start displaying rows like this: 2.01004E+11. These are names not numbers bdw. — David, Apr 01 '14 at 14:57
I have a hard time deciding which of these answers is the best, they are both good for different problems. If you cannot sort the source column you are filtering on, this is superior. Take my upvote :) — David, Apr 01 '14 at 15:17

Copying visible/filtered rows efficiently in excel

2 Answers2

Linked