Quickest way to copy data from another workbook

**Bip** · 12-15-2016, 11:00 PM

Hi, I'm currently using the code below to retrieve rows of data (based on date) from another workbook.
It works well but after using it for a year the rows of data that it has to search has blown out to 30,000 rows, which has made it very slow.
I'm not familiar with using arrays or even if it would help here but is there a quicker way to search and copy data from another workbook?

Sub GetData()
    Dim FileName As String
    Dim DestWB As Workbook
    Dim lastrow As Long
    Dim strdate As String
    Dim DCell As Range
    
    'Get Date to search for
    strdate = ThisWorkbook.Sheets("Variables").Range("A4").Value
    strdate = Format(strdate, "Short Date")
    
    'Get Database Location
    FileName = ThisWorkbook.Sheets("Variables").Range("A8").Value
    
    'Open Database
    Set DestWB = Workbooks.Open(FileName, ReadOnly:=True, notify:=False)
    
    'Copy Data
    ThisWorkbook.Worksheets("List").Rows("2:100000").ClearContents
    lastrow = DestWB.Worksheets("Window1").Cells(Rows.Count, "D").End(xlUp).Row
    For Each DCell In DestWB.Worksheets("Window1").Range("D2:D" & lastrow)
        If CDate(DCell.Value) = strdate Then
            DCell.EntireRow.Copy _
            Destination:=ThisWorkbook.Worksheets("List").Cells(Rows.Count, "A").End(xlUp)(2)
        End If
    Next DCell
    
    'Close Database
    DestWB.Close SaveChanges:=False
    Set DestWB = Nothing
    
End Sub

Thanks
Pete

**Kenneth Hobson** · 12-15-2016, 11:26 PM

Besides the usual speedups like turning off calculation, events, and screen updating, here are a few improvements.
1. Filter by Date and remove the rows.
2. Do not copy the entirerows, copy the UsedRanges that are visible less row one which usually has the column headings.

If you can attach short sample obfuscated files, we can can more easily help. Select the Go Advanced button in lower right of a reply, and scroll down and click the Manage Attachments hyperlink, browse and upload the file(s).

**Bip** · 12-16-2016, 12:32 AM

I've attached a very simplified version of my Workbook and Database, as the original files were just too large to upload.
The only thing you will need to change is the Database location in the Workbook, which is on Sheet2 - Variables
You can also change the search date on this sheet. Although I've only provided data for dates in February this year.

This simplified version is quite fast due to me reducing the size of the database (for uploading purposes).
My database is significantly larger than this and since I'm reading up to 10 sheets of data at a time it has become very slow.
Just wondering if its possible to read each row from the database (if the date matches) into an array, then close the database and write the data into the workbook.
I'm not really sure how to do this or even if it would help reduce the time it takes.

**Bip** · 12-17-2016, 07:47 PM

Bump
Could anyone help me convert this to an array. I've had no experience with this.
Thanks
Pete

**mike7952** · 12-17-2016, 09:09 PM

Give this a try

Const shList As String = "List"
Const shWindow1 As String = "Window1"
Sub ClearData()
    With Worksheets(shList)
        .Range("a2:I" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    End With
End Sub

Sub GetData()
    Dim FileName As String
    Dim DestWB As Workbook
    Dim strdate As String

    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    With ThisWorkbook
            'Get Date to search for
        With .Sheets("Variables")
            strdate = .Range("A4").Value
            strdate = Format(strdate, "Short Date")
            'Get Database Location
            FileName = .Range("A8").Value
        End With
        With Worksheets(shList)
            .Range("a2:I" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
        End With
    End With
    'Open Database
    Set DestWB = Workbooks.Open(FileName, ReadOnly:=True, notify:=False)
    
    ' Load values into an array
    Dim arrData
    With DestWB
        arrData = .Worksheets(Window1).Range("a1").CurrentRegion.Value
        .Close SaveChanges:=False
    End With
    Set DestWB = Nothing
    
    
    Dim rw As Long, col As Long, iLooper As Long
    Dim arrOutput: ReDim arrOutput(1 To UBound(arrData), 1 To UBound(arrData, 2))
    ' Loop thru array arrData and if date is equal then load values to arrOutput Array
    For rw = 2 To UBound(arrData)
        If CDate(arrData(rw, 4)) = strdate Then
            iLooper = 1 + iLooper
            For icol = 1 To UBound(arrData, 2)
                arrOutput(iLooper, icol) = arrData(rw, icol)
            Next
        End If
    Next
    With ThisWorkbook.Worksheets(shList)
        .Cells(2, 1).Resize(iLooper, UBound(arrOutput, 2)) = arrOutput
    End With
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub

**Bip** · 12-17-2016, 10:48 PM

Hi Mike,

Thank you for the effort, much appreciated.

I got your code working after a minor change(typo):

arrData = .Worksheets(shWindow1).Range("a1").CurrentRegion.Value

I then added a timer to my old "Get Data" sub and your new version but the unfortunately the overall improvement was negligible.
In the full version my of my workbook I'm running this routine on up to 10 sheets at once and my users get impatient if they have to wait more than a few seconds.
I've uploaded a larger database (the largest this forum will allow) and a new workbook with both the old and new versions with timers on both.
If anyone can think of any other improvements to speed it up it would be very much appreciated.

Thanks
Pete

**mike7952** · 12-18-2016, 12:35 AM

When running both codes on my computer the code I gave you is faster. I copied the database rows down to 101995. Your code ran about 11 seconds and the code I gave is under 5 seconds. I really don't think you will get any faster then that.

**Bip** · 12-18-2016, 01:33 AM

Wow! you had a significant difference.

I'm guessing that's the difference between Computer Specs, Windows and Office versions we are using.
I just tried again with 101995 rows in the database (like you did). I averaged just over 3 seconds on the old code and just under 3 seconds on your code.
I then doubled the rows to 203989 and re-tested. I averaged about 6.1 seconds on the old code and 5.9 seconds on your code.

After seeing the readings you got, I'm going to go with your code, simply because all the people using my workbook all have different computers.

Mike, thanks again for all your help. I really appreciate it.

Cheers
Pete

**mike7952** · 12-18-2016, 09:03 AM

With 203989 Rows of data in a workbook like you're saying you could have, just manually opening the workbook takes some seconds possibly near a minute to open. You could try saving the database workbook as a xlsb file.

**Kenneth Hobson** · 12-18-2016, 08:26 PM

Here is my ADO with speed tests. I copied the xlsx file's data down to 100001 rows for 100000 check.

'Sub GetData()
'87/16999 desktop 1.90, 1.34, laptop 3.49, 4.93
' 522/100000 laptop 19.47, 19.34

'Sub GetData2()
'87/16999 desktop 0.88, 0.87, laptop 2.38, 2.33
'522/100000 laptop 10.73, 8.75

Sub GetData3()
'522/100000 laptop 3.10, 3.21, 4.49
  'An ADO Method
  Dim FileName$, dDate&, arrData, time1#, time2#, sql$, sConn$
  
  time1 = Timer
  
  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
  End With
  
  With ThisWorkbook.Sheets("Variables")
    dDate = .Range("A4").Value
    FileName = .Range("A8").Value
  End With

'Clear existing List data rows.
  With ThisWorkbook.Worksheets("List")
    .Range("A2", .Cells(Rows.Count, "I").End(xlUp)).ClearContents
  End With

  With CreateObject("ADODB.connection")
    'https://www.connectionstrings.com/excel/
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
      FileName & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    .Open sConn
    sql = "SELECT * FROM [" & shWindow1 & "$A:I] where [Trading Date]=" & dDate
    Worksheets(shList).Range("A2").CopyFromRecordset .Execute(sql)
    .Close
  End With

  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
  End With
  
  time2 = Timer
  MsgBox Format(time2 - time1, "0.00 \s\ec")
End Sub

**Logit** · 12-18-2016, 09:33 PM

Kenneth:

Should your ADO code run on Excel 2007 / Win 10 ?

It fails on

 Worksheets(shList).Range("A2").CopyFromRecordset .Execute(sql)

"Subscript out of range."

**Kenneth Hobson** · 12-18-2016, 09:55 PM

I would think so but I just tested it on win10 Excel 2016. I can test on win7pro Excel 2010 tomorrow. These things usually boil down to the connection string.

https://www.connectionstrings.com/excel/

Do you have a Reference for the Microsoft ActiveX Data Objects 2.8 Library, msado28.tlb? This uses late binding so you don't have to set the reference though it should be in your references.

**Kenneth Hobson** · 12-18-2016, 10:05 PM

Of course that error often happens when the ActiveWorkboook does not have the worksheet with the referenced name. You can make it more explicit with ThisWorkbook.

 ThisWorkbook.Worksheets(shList).Range("A2").CopyFromRecordset .Execute(sql)

**Kenneth Hobson** · 12-18-2016, 10:18 PM

Another way you can get that error is when the file set in Worksheets("Variables").Range("A8").Value does not exist.

**Bip** · 12-19-2016, 12:20 AM

Hi Guys,

I did some more tests today using 203,989 rows in the database and got some major improvements using Mike's code.
I didn't realise until after the tests were completed that I was also running our surveillance system at the same time which is very graphic intensive and taxing on the CPU.
Kenneth, I tried your code (the ADO method) but couldn't achieve the improvements in speed you that did. It was faster than my original code but not always. There seemed to be quite a variation in times each time I ran it. I liked the fact that it didn't need to open the database to read the data though.

Here are the results:
Original code: 15.7 seconds
Mike's code: 4.5 seconds
Kenneth's code: 7.6 to 17.7 seconds

Then here are the results after I closed the surveillance program:
Original code: 11.7 seconds
Mike's code: 3.6 seconds
Kenneth's code: 6.38 to 12.74 seconds

Now the amazing part!
Mike I saw your post regarding saving my database in .xlsb format
I'd never heard of this format before and didn't realize how easy this was to do.
I opened my database, selected Save-as 'Excel Binary Workbook' and then change the variable in my Workbook to search for database.xlsb - too easy!
HOLY WEAPONS OF MASS DESTRUCTION!!! - Check this out!

Original code: 9.49 seconds
Mike's code: 1.45 seconds
Kenneth's code: 10.16 to 10.26 seconds

Based on this simple change and the extra increase in speed, I went straight to my full size Workbook (4MB) and my full size Database (14MB), which is now 6.6MB after saving it as .xlsb, and made the required changes. I can't believe what a difference it made. My workbook is zipping along, grabbing the data with minimal delay now. And that's without changing over to Mike's code.
When I have a spare afternoon in the coming weeks, I will convert all my code over to Mike's new code, which I'm sure will have the whole company dancing in the streets!
I'll report back when I've done this and mark this thread as solved

**Logit** · 12-18-2016, 10:43 PM

Its getting late. I'll look at those suggestions tomorrow. It's probably something stupid and silly that I've done. Let you know.

Thanks.

**Logit** · 12-19-2016, 01:28 PM

Added the "Microsoft ActiveX Data Objects 2.8 Library, msado28.tlb" which helped. Got further into the macro before it failed.

Commented out this line:

'Worksheets(shList).Range("A2").CopyFromRecordset .Execute(sql)

Now failing on this line with a 'Subscript Out Of Range' error:

ThisWorkbook.Worksheets(shList).Range("A2").CopyFromRecordset .Execute(sql)

???

Quickest way to copy data from another workbook

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Re: Quickest way to copy data from another workbook

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Which is the quickest way to loop through large data sets

quickest method for dynamic link to closed workbook

[SOLVED] The quickest way to copy formula

Quickest way to summarize random data

quickest way to copy information to several cells in a very large

loop through a column on a workbook copying data on each row to another workbook, then copy data back to the original workbook

[SOLVED] Quickest way to copy then Paste Special-Values in place?

Bookmarks

Bookmarks

Posting Permissions