Optimize macro

[Nagini]

Hello! I've written this macro, it takes 5 minutes to end the work and I think that maybe someone Knows how to optimize it to make ir faster!


Sub Macro2()


Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False


Dim Indices, Calculos, Seleccion As Worksheet
Set Indices = Sheets("C.Indices")
Set Calculos = Sheets("CALCULOS")
Set Seleccion = Sheets("Sel.Mes")


Dim i As Integer
LastCol = Indices.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 8 To LastCol

Dim j As Integer
j = i - 6

Indices.Columns(i).Copy
Calculos.Select
Columns("D:D").PasteSpecial Paste:=xlPasteValues
Application.Goto Reference:="R318C50"
Range("BR318:CK318").Copy
Seleccion.Select
Cells(j, 1).PasteSpecial Paste:=xlPasteValues

Next i

Application.ScreenUpdating = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False


End Sub

 

[hiker95]

Nagini,

Here is an updated macro for you to consider.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub Macro2_V2()
' hiker95, 12/13/2016, ME980609

Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim Indices As Worksheet, Calculos As Worksheet, Seleccion As Worksheet
Dim i As Long, j As Long, LastCol As Long

Set Indices = Sheets("C.Indices")
Set Calculos = Sheets("CALCULOS")
Set Seleccion = Sheets("Sel.Mes")

LastCol = Indices.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 8 To LastCol

  j = i - 6

  Indices.Columns(i).Copy
  Calculos.Select
  Columns("D:D").PasteSpecial Paste:=xlPasteValues
  Application.Goto Reference:="R318C50"
  Range("BR318:CK318").Copy
  Seleccion.Select
  Cells(j, 1).PasteSpecial Paste:=xlPasteValues
  
  Application.CutCopyMode = False

Next i

Application.ScreenUpdating = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

EndSub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the Macro2_V2 macro.

 

[Nagini]

It works a 5-7% faster, thank you very much!! Do you think there are other options to optimize it even more??

 

[hiker95]

It works a 5-7% faster, thank you very much!!

Nagini,

Thanks for the feedback.

You are very welcome. Glad I could help.

Do you think there are other options to optimize it even more??

I think that the copy's, and, select's, can be refined.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?

 

[hiker95]

Nagini,

You can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com

 

[Nagini]

I'm using:

Windows 10 Pro Version 1607 running with parallels on a Macbook pro
Excel 2016 version 16.0.7571.7060 32 bits (I could use 64 bits version if it is faster)
Both in spanish language

I can't upload the workbook at the moment because all data is sensitive, It's for medical purposes. I will need some time to change it!!

Thank you very much for your attention!!

PD: In addition to the copy's and select's changes, I've read that there are faster options for de "for - to" loops, but I am not really sure if they can be applied to this macro

 

[Norie]

Does this work any faster?

Option Explicit

Sub Macro2_V2()
Dim Indices As Worksheet, Calculos As Worksheet, Seleccion As Worksheet
Dim i As Long, j As Long, LastCol As Long

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False

    Set Indices = Sheets("C.Indices")
    Set Calculos = Sheets("CALCULOS")
    Set Seleccion = Sheets("Sel.Mes")

    LastCol = Indices.Cells(1, Columns.Count).End(xlToLeft).Column

    For i = 8 To LastCol

        j = i - 6

        Indices.Columns(i).Copy
        Calculos.Range("D1").PasteSpecial Paste:=xlPasteValues
        Calculos.Range("BR318:CK318").Copy
        Seleccion.Cells(j, 1).PasteSpecial Paste:=xlPasteValues

        Application.CutCopyMode = False

    Next i
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True

End Sub

 

[Nagini]

Hello Norie!!! Same speed

 

[Norie]

Are you doing a lot of calculations?

 

[Nagini]

yes I have that macro repeated for 8 sheets. Each sheet does the loop about 200 times.

It takes at home with a macbook pro about 30s per sheet, 4 min total, with a macbook pro running parallels and the last version of excel.

With a much worse pc at work and excel 2003 it runs 2 times faster, 15s per sheet