• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Make code simplier and faster

jonastiger

jonastiger

Member
Hi
I wonder if there is a way to make this code below simplier and faster:

Sub CopyDataGERAL()

Dim wsSource As Worksheet
Dim wsTarget As Worksheet

Workbooks.Open FileName:=ThisWorkbook.Path & "\GeneralList.xlsx"

Set wsSource = Workbooks("GeneralList.xlsx").Worksheets("Geral")
Set wsTarget = ThisWorkbook.Worksheets("ListGERAL")

wsSource.Range("A17511:A100000").Copy
wsTarget.Range("A3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("AE17511:AF100000").Copy
wsTarget.Range("B3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("D17511:D100000").Copy
wsTarget.Range("D3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("G17511:G100000").Copy
wsTarget.Range("E3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("J17511:J100000").Copy
wsTarget.Range("F3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("S17511:S100000").Copy
wsTarget.Range("G3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("U17511:U100000").Copy
wsTarget.Range("H3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("W17511:W100000").Copy
wsTarget.Range("I3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("Y17511:Y100000").Copy
wsTarget.Range("J3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("AA17511:AA100000").Copy
wsTarget.Range("K3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("AL17511:AM100000").Copy
wsTarget.Range("L3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("AO17511:AT100000").Copy
wsTarget.Range("N3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("AV17511:AW100000").Copy
wsTarget.Range("T3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("BX17511:CF100000").Copy
wsTarget.Range("V3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("BG17511:BH100000").Copy
wsTarget.Range("AE3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("BJ17511:BJ100000").Copy
wsTarget.Range("AG3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("BL17511:BL100000").Copy
wsTarget.Range("AH3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("BO17511:BP100000").Copy
wsTarget.Range("AI3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("BW17511:BW100000").Copy
wsTarget.Range("AK3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("CK17511:CK100000").Copy
wsTarget.Range("AL3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("DE17511:DE100000").Copy
wsTarget.Range("AM3").PasteSpecial Paste:=xlPasteValues
wsSource.Range("DH17511:DH100000").Copy
wsTarget.Range("AN3").PasteSpecial Paste:=xlPasteValues

Workbooks("GeneralList.xlsx").Close savechanges:=False

End Sub

Any help would be blessed.

Thank You very much
JT
 
Please paste code between code tags as shown in the Tip above a reply/post or click the <> icon in the reply toolbar.

Are you sure that you need to copy that many rows? The code can easily find the lastrow which would be more efficient.

Otherwise:
Code: 
Sub CopyDataGERAL()
  Dim wsSource As Worksheet, wsTarget As Worksheet
 
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
 
  Workbooks.Open Filename:=ThisWorkbook.Path & "\GeneralList.xlsx"
  Set wsSource = Workbooks("GeneralList.xlsx").Worksheets("Geral")
  Set wsTarget = ThisWorkbook.Worksheets("ListGERAL")
 
  With wsSource
    .Range("A17511:A100000").Copy
      wsTarget.Range("A3").PasteSpecial Paste:=xlPasteValues
    .Range("AE17511:AF100000").Copy
      wsTarget.Range("B3").PasteSpecial Paste:=xlPasteValues
    .Range("D17511:D100000").Copy
      wsTarget.Range("D3").PasteSpecial Paste:=xlPasteValues
    .Range("G17511:G100000").Copy
      wsTarget.Range("E3").PasteSpecial Paste:=xlPasteValues
    .Range("J17511:J100000").Copy
      wsTarget.Range("F3").PasteSpecial Paste:=xlPasteValues
    .Range("S17511:S100000").Copy
      wsTarget.Range("G3").PasteSpecial Paste:=xlPasteValues
    .Range("U17511:U100000").Copy
      wsTarget.Range("H3").PasteSpecial Paste:=xlPasteValues
    .Range("W17511:W100000").Copy
      wsTarget.Range("I3").PasteSpecial Paste:=xlPasteValues
    .Range("Y17511:Y100000").Copy
      wsTarget.Range("J3").PasteSpecial Paste:=xlPasteValues
    .Range("AA17511:AA100000").Copy
      wsTarget.Range("K3").PasteSpecial Paste:=xlPasteValues
    .Range("AL17511:AM100000").Copy
      wsTarget.Range("L3").PasteSpecial Paste:=xlPasteValues
    .Range("AO17511:AT100000").Copy
      wsTarget.Range("N3").PasteSpecial Paste:=xlPasteValues
    .Range("AV17511:AW100000").Copy
      wsTarget.Range("T3").PasteSpecial Paste:=xlPasteValues
    .Range("BX17511:CF100000").Copy
      wsTarget.Range("V3").PasteSpecial Paste:=xlPasteValues
    .Range("BG17511:BH100000").Copy
      wsTarget.Range("AE3").PasteSpecial Paste:=xlPasteValues
    .Range("BJ17511:BJ100000").Copy
      wsTarget.Range("AG3").PasteSpecial Paste:=xlPasteValues
    .Range("BL17511:BL100000").Copy
      wsTarget.Range("AH3").PasteSpecial Paste:=xlPasteValues
    .Range("BO17511:BP100000").Copy
      wsTarget.Range("AI3").PasteSpecial Paste:=xlPasteValues
    .Range("BW17511:BW100000").Copy
      wsTarget.Range("AK3").PasteSpecial Paste:=xlPasteValues
    .Range("CK17511:CK100000").Copy
      wsTarget.Range("AL3").PasteSpecial Paste:=xlPasteValues
    .Range("DE17511:DE100000").Copy
      wsTarget.Range("AM3").PasteSpecial Paste:=xlPasteValues
    .Range("DH17511:DH100000").Copy
      wsTarget.Range("AN3").PasteSpecial Paste:=xlPasteValues
  End With
 
  Workbooks("GeneralList.xlsx").Close savechanges:=False
 
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.CutCopyMode = False
End Sub
 
It is always a lot faster to make the new range equal to the old range rather than copy/paste

eg:
No_Rows =100000-17511+1

wsTarget.Range("A3").resize(No_Rows,0).value = .Range("A17511:A100000").Value
 
Hi Kenneth and Hui
Thank you so much for your suggestions
I have tried both and Hui's options seems not working, but maybe there is a syntax problem... (go to check again)

Kenneth:
Your option works fine and a little bit faster then mine (I added LastRow too).
Answering to your question, that file is a daily updated report and I need to anlyse those ranges, so yes I need to copy all those rows.

Thank You again
JT
 
JT if you attach a sample file we can check for you
Ensure the ranges are the same size
 
Another option
Code: 
Sub CopyDataGERAL()
  Dim wsSource As Worksheet, wsTarget As Worksheet
  Dim Ary As Variant
  Dim i As Long
 
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
 
  Ary = Array("A3", "A17511", 1, "B3", "AE17511", 2, "D3", "D17511", 1, "E3", "G17511", 1, "F3", "J17511", 1 _
              , "G3", "S17511", 1, "H3", "U17511", 1, "I3", "W17511", 1, "J3", "Y17511", 1, "K3", "AA17511", 1 _
              , "L3", "AL17511", 2, "N3", "AO17511", 6, "T3", "AV17511", 2, "V3", "BX17511", 9, "AE3", "BG17511", 2 _
              , "AG3", "BJ17511", 1, "AH3", "BL17511", 1, "AI3", "BO17511", 2, "AK3", "BW17511", 1 _
              , "AL3", "CK17511", 1, "AM3", "DE17511", 1, "AN3", "DH17511", 1)
 
  Workbooks.Open FileName:=ThisWorkbook.Path & "\GeneralList.xlsx"
  Set wsSource = Workbooks("GeneralList.xlsx").Worksheets("Geral")
  Set wsTarget = ThisWorkbook.Worksheets("ListGERAL")
 
  With wsSource
      For i = 0 To UBound(Ary) Step 3
        wsTarget.Range(Ary(i)).Resize(82490, Ary(i + 2)).Value = _
            wsSource.Range(Ary(i + 1)).Resize(82490, Ary(i + 2)).Value
      Next i
  End With

  Workbooks("GeneralList.xlsx").Close savechanges:=False
 
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.CutCopyMode = False
End Sub
 
Can you please try:

No_Rows =100000-17511+1

wsTarget.Range("A3").resize(No_Rows, 1).value = wsSource.Range("A17511:A100000").Value
 
like this

Code: 
Sub CopyDataGERAL()
  Dim wsSource As Worksheet, wsTarget As Worksheet
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  Workbooks.Open Filename:=ThisWorkbook.Path & "\GeneralList.xlsx"
  Set wsSource = Workbooks("GeneralList.xlsx").Worksheets("Geral")
  Set wsTarget = ThisWorkbook.Worksheets("ListGERAL")
  No_Rows = 100000 - 17511 + 1

  Range("A3").Resize(No_Rows, 1).Value = Range("A17511:A100000").Value
  With wsSource
      wsTarget.Range("A3").Resize(No_Rows, 1).Value = .Range("A17511:A100000").Value
      wsTarget.Range("B3").Resize(No_Rows, 2).Value = .Range("AE17511:AF100000").Value
      wsTarget.Range("D3").Resize(No_Rows, 1).Value = .Range("D17511:D100000").Value
       
      wsTarget.Range("E3").Resize(No_Rows, 1).Value = .Range("G17511:G100000").Value
      wsTarget.Range("F3").Resize(No_Rows, 1).Value = .Range("J17511:J100000").Value
      wsTarget.Range("G3").Resize(No_Rows, 1).Value = .Range("S17511:S100000").Value
      wsTarget.Range("H3").Resize(No_Rows, 1).Value = .Range("U17511:U100000").Value
      wsTarget.Range("I3").Resize(No_Rows, 1).Value = .Range("W17511:W100000").Value
      wsTarget.Range("J3").Resize(No_Rows, 1).Value = .Range("Y17511:Y100000").Value
      wsTarget.Range("K3").Resize(No_Rows, 1).Value = .Range("AA17511:AA100000").Value
       
      wsTarget.Range("L3").Resize(No_Rows, 2).Value = .Range("AL17511:AM100000").Value
       
      wsTarget.Range("N3").Resize(No_Rows, 6).Value = .Range("AO17511:AT100000").Value
      wsTarget.Range("T3").Resize(No_Rows, 2).Value = .Range("AV17511:AW100000").Value
      wsTarget.Range("V3").Resize(No_Rows, 9).Value = .Range("BX17511:CF100000").Value
      wsTarget.Range("AE3").Resize(No_Rows, 2).Value = .Range("BG17511:BH100000").Value
      wsTarget.Range("AG3").Resize(No_Rows, 1).Value = .Range("BJ17511:BJ100000").Value
       
      wsTarget.Range("AH3").Resize(No_Rows, 1).Value = .Range("BL17511:BL100000").Value
      wsTarget.Range("AI").Resize(No_Rows, 2).Value = .Range("BO17511:BP100000").Value
      wsTarget.Range("AK3").Resize(No_Rows, 1).Value = .Range("BW17511:BW100000").Value
      wsTarget.Range("AL3").Resize(No_Rows, 1).Value = .Range("CK17511:CK100000").Value
      wsTarget.Range("AM3").Resize(No_Rows, 1).Value = .Range("DE17511:DE100000").Value
      wsTarget.Range("AN3").Resize(No_Rows, 1).Value = .Range("DH17511:DH100000").Value
   
  End With
  Workbooks("GeneralList.xlsx").Close savechanges:=False
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.CutCopyMode = False
End Sub
 
Hi Hui
Your code gives a compile error - Variable not defined
Should I define No_Rows As Variant?

UPDATE:
I add Dim No_Rows As Variant
and it works fine. Thank you very much.
However code don't run so fast as desired and my first issue is to get a faster way to import that data
 
Last edited:
Hi FLuff
Thank you so much for bringing another option.
It works really fine and and it's the faster one and with less code.

I'm not so familiar with array. Since the source is a daily report with variable number of rows, how do I suit the foloowed section with a
Code: 
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
?

Code: 
With wsSource
      For i = 0 To UBound(Ary) Step 3
        wsTarget.Range(Ary(i)).Resize(82490, Ary(i + 2)).Value = _
            wsSource.Range(Ary(i + 1)).Resize(82490, Ary(i + 2)).Value
      Next i
  End With

Thanks in advance
JT
 
If you always want to copy from row17511to last row try
Code: 
  With wsSource
      Lr = .Range("A" & Rows.Count).End(xlUp).Row
      For i = 0 To UBound(Ary) Step 3
        wsTarget.Range(Ary(i)).Resize(Lr - 17510, Ary(i + 2)).Value = _
            wsSource.Range(Ary(i + 1)).Resize(Lr - 17510, Ary(i + 2)).Value
      Next i
  End With
 
Hi All
This is to thank your help and feedback.
After adapting code to my real file, results were:
My initial code - File takes more than 4 minutes to open
With Kenneth's suggestion - File opens in almost 4 minutes (15-20 seconds less then initial)
With HUI's - ~2:40 minutes
With Fluff's - ~1:20 minutes

These tests were made with Windows 2013 32bits
I´m going to try in my new machine with Windows 2016 64 bits. I´m expecting to get better results.

Thank you all for your time and bless you.
JT
 
I could not duplicate your time results, ranking-wise. Of course in my post I explained that it could be faster if the last cell was found rather than hard coding it.

Time tests are a relative thing. Often, the first run will take longer. The way you run it in production mode or development mode (VBE) matters. Obviously, cell content maters as well.

The link to my files in case you want to compare routines or add other routines easily to compare apples to apples is at the end. Files size gets pretty big when you have that many rows and columns with data.

This routine, my last effort, has the times commented at the end FWIW. I used two time methods. The timer() method is good enough. See my files or remove the cTimer class method or both. Timing is just for kicks.

This too is sort of hard coded but could be more dynamically coded if needed. Mostly, it is just to show an alternate method. See the attachment for the other timed methods. Mostly, those others used a Union() method and some used a modified version of Fluff's method. Most always, arrays, and writing just one time are the fastest.

Code: 
Sub Ken5()
  Dim t As New cTimer, d As Double
  t.StartCounter
  d = Timer

  Dim wsSource As Worksheet, wsTarget As Worksheet
  Dim r As Range, br As Long, er As Long, nr As Long
  Dim a, s$

  br = 17511
  er = 100000
  nr = er - br + 1
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  Application.DisplayAlerts = False
  Workbooks.Open Filename:=ThisWorkbook.Path & "\GeneralList.xlsx"
  Set wsSource = Workbooks("GeneralList.xlsx").Worksheets("Geral")
  Set wsTarget = ThisWorkbook.Worksheets("ListGERAL")
  With wsSource
    s = "1 4 7 10 19 21 23 25 27 31 32 38 39 41 42 43 44 45 46 48 49 59 " _
        & "60 62 64 67 68 75 76 77 78 79 80 81 82 83 84 89 109 112"
    a = Application.Index(.Range(.Cells(br, "A"), .Cells(er, "DH")), _
      Evaluate("Row(1:" & nr & ")"), Split(s))
  End With
  '28s to this point
  wsTarget.[A3].Resize(UBound(a, 1), UBound(a, 2)) = a

  Workbooks("GeneralList.xlsx").Close savechanges:=False
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  Application.CutCopyMode = False
  Debug.Print "ken5", t.TimeElapsed / 1000, Timer - d & " seconds."
End Sub

'ken1      51.4720307398213        51.4765625 seconds.
'ken1      37.6338901397789        37.625 seconds.
'ken2      111.498228867977        111.5 seconds.
'ken2      103.834181372643        103.8359375 seconds.
'ken3      86.066469090186          86.06640625 seconds.
'ken3      85.1192149542302        85.125 seconds.
'ken4      29.5193028372752        29.5234375 seconds. 'No write back.
'ken5      35.9670656685205        35.96875 seconds.
'ken5      35.8549609016672        35.8515625 seconds.
'fluff        54.0781645914721        54.07421875 seconds.
'fluff        53.6292682613911        53.640625 seconds.

https://www.dropbox.com/s/yeq1qo7fzzspq55/GeneralList.zip?dl=0
 
Last edited:
Hi Kenneth
What can I say...
People like you, like the others here, who make their time, knowledge and experience available to others, deserve to be congratulated every day for the help you provide. I was expecting a little help, and I got a fantastic set of options.
Thank You very much

I will take the weekend to test this new approach and give feedback.
However, I am having two problems that I have to solve:
1 - I send my file to several users and it has to run on Excel2013, Excel2016 and O365, 32 and 64bit. I think there is a 64 bit related problem with Declare statement.
2 - I put the code to run when file opening. So, while open and after running macros, Excel shuts off. However, if I open Excel and create a new blank file and then open my file, the thing runs normal.

My opening statement:

Code: 
Private Sub Workbook_Open ()
Call CopyDataGeral
Call CopyDataAbertos
Call CopyDataEng1
Call CopyDataEng2
Call CopyDataPlano

MsgBox "UPDATED - " & ThisWorkbook.Name

End Sub

Thank you again
JT
 
I don't see any Declare in the code. When using Declare for API routines, 32 bit versus 64 bit may need special handling but can be addressed by doing both. If that is happening, we would need to see the code. Dims would also need handling when Declare has the version issue.

Do you mean Dim issue rather than Declare? If Dim is an issue, break multiple Dims into a Dim for each to troubleshoot. Even so, I don't see anything that would be a problem in the code posted in any Excel version.

Opening a file in the foreground, like we did in this thread, usually takes longer than background methods. Some background methods to get the data may have version specific needs. Each method has trade-offs. e.g. One thing that is easier in foreground method is getting the last used cell/row. Static ranges are good for background methods. On the flip side, by using ADO, SQL can be used to query the data.

FWIW:
With multiple calls doing foreground things, you might want to add a DoEvents before the Call. The word Call is not needed as it is inferred but it doesn't hurt anything. One might use Call if you pass parameter values to the routine. e.g.
Code: 
Sub Test_Hi()
  Call Hi("Hello")
  Hi "hi"
End Sub

Sub Hi(s$)
  MsgBox s
End Sub
Note use of ()'s.
 
Hi Kenneth
Sorry for the late feedback, but it took more time than I preview trying all optins available by you. Once again, Thank you very much for your help.
I got better results with Ken4, although they were not so relevant, but it was worth the effort.
Applied to a single macro, your code is actually much faster, but when I call all macros when I open the file, as mentioned in post #14, the difference in speed is very small. I think this is due to the fact that the amount of data to be copied is very large.
My present issue is if I start excel with this file, Excel shuts off. However, if I open Excel and create a new blank file and then open my file, the thing runs normal.
Not familiar with ADO and SQL commands and methods.

Thanks
JT
 
You must log in or register to reply here.
Back
Top