Optimize macro

N

Nagini

New Member
Joined
Dec 11, 2016
Messages
34
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
 
Sort by date Sort by votes
Well it is not exactly that. All the rows of sheet "Seleccion" have the same values except in one column. I think that the problem is that the cells in the range "BR318:CK318" contain formula, and something in the "with" order prevent them to be applied from i = i to i = i + 1 (next loop).

I don't know If I'm explaining it well.
 
Upvote 0

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
The line amended has nothing to do with that line as CalcRange is set way earlier in the code on the line below...
Code: 
 CalcRange = Calculos.Range("BR318:CK318").Value
 
Upvote 0
Here is the result I have using this code (not wished result)

Code: 
[COLOR=#011993][FONT=Menlo]
[/FONT][/COLOR][COLOR=#000000][FONT=Menlo][COLOR=#011993]Sub[/COLOR] Macro2()[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Dim[/COLOR] Indices [COLOR=#011993]As[/COLOR] Worksheet, Calculos [COLOR=#011993]As[/COLOR] Worksheet, Seleccion [COLOR=#011993]As[/COLOR] Worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Dim[/COLOR] i [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR], j [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR], LastCol [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR], lRow [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR], CalcRange [COLOR=#011993]As[/COLOR] [COLOR=#011993]Variant[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]Application.ScreenUpdating = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]Application.DisplayStatusBar = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]Application.EnableEvents = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]ActiveSheet.DisplayPageBreaks = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Set[/COLOR] Indices = Sheets("C.Indices")[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Set[/COLOR] Calculos = Sheets("CALCULOS")[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Set[/COLOR] Seleccion = Sheets("Sel.Mes")[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]LastCol = Indices.Cells(1, Columns.Count).End(xlToLeft).Column[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]For[/FONT][/COLOR][COLOR=#000000][FONT=Menlo] i = 8 [/FONT][/COLOR][COLOR=#011993][FONT=Menlo]To[/FONT][/COLOR][COLOR=#000000][FONT=Menlo] LastCol[/FONT][/COLOR][FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]  CalcRange = Calculos.Range("BR318:CK318").Value[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]  lRow = Indices.Cells(1, i).End(xlDown).Row[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]  j = i - 6[/FONT][/COLOR]

[COLOR=#000000][FONT=Menlo]  [COLOR=#011993]With[/COLOR] Indices.Range(Indices.Cells(1, i), Indices.Cells(lRow, i))[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]  Calculos.Cells(1, 4).Resize(.Rows.Count, .Columns.Count).Value = .Value[/FONT][/COLOR]
[COLOR=#011993][FONT=Menlo] EndWith[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]  Seleccion.Range("A" & j & ":T" & j).Value = CalcRange[/FONT][/COLOR]

[COLOR=#000000][FONT=Menlo]  Application.CutCopyMode = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]

[COLOR=#011993][FONT=Menlo]Next[COLOR=#000000] i[/COLOR][/FONT][/COLOR][COLOR=#000000]
[/COLOR][FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]Application.ScreenUpdating = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]Application.EnableEvents = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]Application.DisplayStatusBar = statusBarState[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]ActiveSheet.DisplayPageBreaks = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]EndSub[/FONT][/COLOR]

Captura_de_pantalla_2016_12_14_a_las_18_36_53.png


And here is the one I had using the previous code (wished result)

Code: 
[COLOR=#000000][FONT=Menlo][COLOR=#011993]
[/COLOR][/FONT][/COLOR][COLOR=#000000][FONT=Menlo][COLOR=#011993]Sub[/COLOR] Macro2()[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Dim[/COLOR] Indices [COLOR=#011993]As[/COLOR] Worksheet, Calculos [COLOR=#011993]As[/COLOR] Worksheet, Seleccion [COLOR=#011993]As[/COLOR] Worksheet[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Dim[/COLOR] i [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR], j [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR], LastCol [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR], lRow [COLOR=#011993]As[/COLOR] [COLOR=#011993]Long[/COLOR], CalcRange [COLOR=#011993]As[/COLOR] [COLOR=#011993]Variant[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]Application.ScreenUpdating = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]Application.DisplayStatusBar = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]Application.EnableEvents = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]ActiveSheet.DisplayPageBreaks = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Set[/COLOR] Indices = Sheets("C.Indices")[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Set[/COLOR] Calculos = Sheets("CALCULOS")[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]Set[/COLOR] Seleccion = Sheets("Sel.Mes")[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]LastCol = Indices.Cells(1, Columns.Count).End(xlToLeft).Column[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo][COLOR=#011993]For[/COLOR] i = 8 [COLOR=#011993]To[/COLOR] LastCol[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]  CalcRange = Calculos.Range("BR318:CK318").Value[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]  lRow = Indices.Cells(1, i).End(xlDown).Row[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]  j = i - 6[/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#000000][FONT=Menlo]  Indices.Columns(i).Copy[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]  Calculos.Range("D1").PasteSpecial Paste:=xlPasteValues[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]  Seleccion.Range("A" & j & ":T" & j).Value = CalcRange[/FONT][/COLOR]

[COLOR=#000000][FONT=Menlo]  Application.CutCopyMode = [COLOR=#011993]False[/COLOR][/FONT][/COLOR]

[COLOR=#011993][FONT=Menlo]Next[COLOR=#000000] i[/COLOR][/FONT][/COLOR]
[COLOR=#000000]
[/COLOR][COLOR=#000000][FONT=Menlo]Application.ScreenUpdating = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]Application.EnableEvents = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]Application.DisplayStatusBar = statusBarState[/FONT][/COLOR]
[COLOR=#000000][FONT=Menlo]ActiveSheet.DisplayPageBreaks = [COLOR=#011993]True[/COLOR][/FONT][/COLOR]
[FONT=Menlo]
[/FONT]
[COLOR=#011993][FONT=Menlo]EndSub[/FONT][/COLOR]

072073c0631a3deeaaac0fb33734cc06o.png


Great difference in the speed, but the final product isn't the same!!
 
Last edited:
Upvote 0
Post a copyable screenshot of all your sheets (see my signature block below for some ways to do this) or upload your workbook to a free file hosting site like www.box.com, mark it for sharing and then post the link it provides in the thread, then I will look at it when I am next on a computer.
 
Last edited:
Upvote 0
I'm so sorry but it is a huge workbook with lots of sensitive data, I am not able to update it :/

Can't find a solution with the information in the previous post?? :(
 
Last edited:
Upvote 0
I have no intention of retyping/creating data to test.

Copy a small section of your data with a portion of the relevant ranges (from each sheet) to a fresh workbook , sanitise the data and post that or hopefully someone else will step in to help.
 
Upvote 0
Based on what I'm seeing, your macro is intended to copy formulas, not values. Although Mark's code sped it up considerably, since it did not copy the formulas, you got a different result.

At this point, I would recommend you stick with the working macro you have. I'm sure that it could be sped up by analyzing the formulas in your spreadsheet and performing them in the macro instead of on the spreadsheet, but that would be a lengthy process. You'd need to get a consultant to work on it as a dedicated project. You'd have to give the consultant the workbook to look at, but you'd also be able to get him to sign a non-disclosure agreement.

Sorry we don't have a better answer for you, but there is a limit to what can be done via volunteers on a public bulletin board.
 
Upvote 0
If you are only interested on getting the values produced by the formulas into the range then really you need to be looking into feeding them into an array to speed up the code but as I have intimated it would not be something I am willing to do without some data to test on.

There are others who might well be willing to do so with the info you have posted but if not (or if you want to keep the formulas) I agree with Eric W that you might be better off sticking with what you currently have, especially as you understand it.

Sorry but I can't be of more help.
 
Upvote 0
You're making a great job and helping me a lot. Erik, Mark, I'm trying to design a workbook with sanitized data, It is taking me some time but I will upload it if I achieve to eliminate all the important data!!
 
Upvote 0
Mark, Eric, here is a link to a sanitized version of the workbook.

https://www.dropbox.com/s/9lubex12zihjlad/Prueba.xlsm?dl=0

I don't know why but I've copied the macro that works in the real sheet and it doesn't work in this one.

The idea is to:

Copy column H of C. Indices
Special Paste in column D of CALCULOS
Copy E318:BS318 in CALCULOS (those cells apply sheet formula)
Special Paste in Sel.Mes B2

And repeat it from column H to the last one in C.Indices and from arrow 2 to the last one in Sel.Mes

Thank you very much if you can help me!! (Also if you can't) :P
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
another way to speed the macro .
Replies
3
Views
526
Georgiboy
Georgiboy
E
  • Question
Help Cleaning Up / Optimizing VBA Code
Replies
6
Views
296
offthelip
O
F
  • Question
VBA Import columns by headers - Need prompts to select workbook/sheet name
Replies
2
Views
204
floggingmolly
F
R
  • Question
Save As does not work properly
Replies
7
Views
820
Rainmanne
R
R
  • Solved
Code Opens File but Isn't Closing It
Replies
4
Views
291
reberryjr
R

Forum statistics

Threads
1,215,182
Messages
6,123,517
Members
449,102
Latest member
admvlad

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top