Copying visible/filtered rows efficiently in excel - vba

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.

Answer 1

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

Answer 2

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