swjtx99
asked on
Speed up copying of rows from one workbook to another
Hi,
An expert recently provided the solution below which works perfectly except with the size of my dataset, its taking 17 minutes to execute. Is there anyway to speed it up considerably?
The code executes in a workbook (the Destination), opens another workbook (the Source) sheet1, copies all rows from the source where the date in column A of the source is greater than the latest (max) date in Column A sheet "Raw Data" of the destination (starting with the next blank row of any existing data)
Any help would be greatly appreciated!
Sub LoadData()
Dim srcWb As Workbook
Dim srcWs As Worksheet, destWs As Worksheet
Dim maxDate As Date
Dim i As Long, destCurrRow As Long
Application.ScreenUpdating = False
Set destWs = ActiveWorkbook.Sheets("Raw Data")
Set srcWb = Workbooks.Open("C:\!Data\B ook1.xlsx" )
Set srcWs = srcWb.Sheets("Sheet1")
'Get Max Date
maxDate = Application.WorksheetFunct ion.Max(de stWs.Range ("A:A"))
destCurrRow = destWs.Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To srcWs.Range("A" & Rows.Count).End(xlUp).Row
If srcWs.Range("A" & i).Value > maxDate Then
srcWs.Range("A" & i).EntireRow.Copy destWs.Range("A" & destCurrRow)
destCurrRow = destCurrRow + 1
End If
Next i
Application.DisplayAlerts = False 'avoids clipboard message
srcWb.Close SaveChanges:=False
Application.DisplayAlerts = True
Worksheets("Table").Select
Application.ScreenUpdating = True
MsgBox "Data was successfully imported!", vbInformation
End Sub
Thanks in advance,
swjtx99
An expert recently provided the solution below which works perfectly except with the size of my dataset, its taking 17 minutes to execute. Is there anyway to speed it up considerably?
The code executes in a workbook (the Destination), opens another workbook (the Source) sheet1, copies all rows from the source where the date in column A of the source is greater than the latest (max) date in Column A sheet "Raw Data" of the destination (starting with the next blank row of any existing data)
Any help would be greatly appreciated!
Sub LoadData()
Dim srcWb As Workbook
Dim srcWs As Worksheet, destWs As Worksheet
Dim maxDate As Date
Dim i As Long, destCurrRow As Long
Application.ScreenUpdating
Set destWs = ActiveWorkbook.Sheets("Raw
Set srcWb = Workbooks.Open("C:\!Data\B
Set srcWs = srcWb.Sheets("Sheet1")
'Get Max Date
maxDate = Application.WorksheetFunct
destCurrRow = destWs.Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To srcWs.Range("A" & Rows.Count).End(xlUp).Row
If srcWs.Range("A" & i).Value > maxDate Then
srcWs.Range("A" & i).EntireRow.Copy destWs.Range("A" & destCurrRow)
destCurrRow = destCurrRow + 1
End If
Next i
Application.DisplayAlerts = False 'avoids clipboard message
srcWb.Close SaveChanges:=False
Application.DisplayAlerts = True
Worksheets("Table").Select
Application.ScreenUpdating
MsgBox "Data was successfully imported!", vbInformation
End Sub
Thanks in advance,
swjtx99
How about using a Filter to just show the rows with the desired date and then copy all the rows that are still visible (at once) to the new workbook?
ASKER
Hi Martin,
Thanks for the reply. That is how I'm doing it now (manually) and wanted to automate it. I suppose if in VBA a filter could be applied to hide/delete all rows with a date in Column A of the Source workbook older than the latest date in the Destination and then copy everything over at once, that would also work.
Thanks,
swjtx99
Thanks for the reply. That is how I'm doing it now (manually) and wanted to automate it. I suppose if in VBA a filter could be applied to hide/delete all rows with a date in Column A of the Source workbook older than the latest date in the Destination and then copy everything over at once, that would also work.
Thanks,
swjtx99
You could record a macro while you do it manually. You could also provide me cut down versions of the two workbooks and I can do it for you.
The following could be used as the starting point for the new macro. Right now it filters, copies and pastes from one sheet to another in the same workbook and that and the filter date would need to be changed.
Sub OneFellSwoop()
Dim rng As Range
Dim lngVisibleCount As Long
Set rng = Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)
' Clear any existing filter
rng.AutoFilter
With rng
' Filter out everything that doesn't have 2/20/2015 as the date in coulmn 1
.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, "2/20/2015")
' Copy the visible rows
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
End With
' Get a count of the visible rows
lngVisibleCount = Cells(1).CurrentRegion.Columns(1).SpecialCells(xlCellTypeVisible).Count
With Sheets("sheet2")
.Select
' select the number of rows as the destination for the paste
.Range("A1:A" & lngVisibleCount).Select
.Paste
End With
Application.CutCopyMode = False
Selection.AutoFilter
End Sub
ASKER
Hi Martin,
Thank you. I'll see if I can work it out based on your starting point. If not, I'll post cut down versions of the files.
Sincerely,
swjtx99
Thank you. I'll see if I can work it out based on your starting point. If not, I'll post cut down versions of the files.
Sincerely,
swjtx99
Set calculation setting to manual in the beginning, if not needed.
Application.Calculation = xlCalculationManual
And set back again to automatic, if needed.Application.Calculation = xlCalculationAutomatic
Excel tries to calculate all workbooks opened in the same application instance even when a single cell value changes.
ASKER
Hi Hakan,
Thanks. I did have that in the working version but it was of little help.
I've attached a cut version of the two workbooks. The "Destination Workbook.xls" contains the macro I'm using now. The "testdata.xls" is the workbook that contains the rows I want to copy over to the destination (only those that have a date in column A after the max date found in column A of the Destination workbook).
If you put both of these into a folder named c:\!data and run it you can observe how slow it is and again, these are smaller versions of the actual files.
Thanks,
swjtx99
Destination-Workbook.xls
testdata.xls
Thanks. I did have that in the working version but it was of little help.
I've attached a cut version of the two workbooks. The "Destination Workbook.xls" contains the macro I'm using now. The "testdata.xls" is the workbook that contains the rows I want to copy over to the destination (only those that have a date in column A after the max date found in column A of the Destination workbook).
If you put both of these into a folder named c:\!data and run it you can observe how slow it is and again, these are smaller versions of the actual files.
Thanks,
swjtx99
Destination-Workbook.xls
testdata.xls
Use this instead of copying.
destWs.Range("A" & destCurrRow).EntireRow.Value = srcWs.Range("A" & i).EntireRow.Value
Or this, simpler.destWs.Rows(destCurrRow).Value = srcWs.Rows(i).Value
Or this may even be fasterdestWs.Rows(destCurrRow).Value2 = srcWs.Rows(i).Value2
And then format new rows if needed.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks to all who responded for your time.
Eigel, this solution worked very well and very fast. Even on the production workbook with over 50K rows, it only took a few seconds. Exactly what I needed.
Very much appreciate your help.
Regards,
swjtx99
Eigel, this solution worked very well and very fast. Even on the production workbook with over 50K rows, it only took a few seconds. Exactly what I needed.
Very much appreciate your help.
Regards,
swjtx99
Again in Ejgil Hedegaard's code, use this instead of copying cells.
If i <= sourceMaxRow Then
destWs.Range(destWs.Cells(destCurrRow, 1), destWs.Cells(destCurrRow + sourceMaxRow - i, sourceMaxColumn)).Value2 = _
srcWs.Range(Cells(i, 1), Cells(sourceMaxRow, sourceMaxColumn)).Value2
End If
ASKER
Hi Hakan,
Thanks for the additional info. What does this do? Does this speed up the execution?
Regards,
swjtx99
Thanks for the additional info. What does this do? Does this speed up the execution?
Regards,
swjtx99
Of course. This only copies values without formats. You may also modify Ejgil's code to paste values only.
But i prefer direct setting of cell values; you don't have to switch sheet or select a cell before.
But i prefer direct setting of cell values; you don't have to switch sheet or select a cell before.