Macro takes 8 minutes. HELP!!!

hejredersejre

New Member
Joined
Aug 5, 2013
Messages
7
Dear all

I'm currently working in a giant budget spreadsheet with lots of data.
I have a macro that i need to run to update my numbers.
My issue is that it takes 8 min for it to finish which is quite frustrating.

Does any of you have the skills and will to see my macro through and see if there is any room for improvement/errors in it.

Best regards
Anders

macro:

Sub Level_2_Rapport()


Application.ScreenUpdating = False




Worksheets("Data - Level 1").Activate


Range("A2").Select

Dim L1 As Long
Dim V1 As Long
Dim L2 As Long
Dim V2 As Long
Dim Test As Long


V1 = 0

V2 = 0

Worksheets("Styring").Activate

L1 = Range("G26").Value
L2 = Range("G23").Value

Worksheets("Data - Level 2").Activate

Rows("3:10000").Offset(L2, 0).Select
Selection.Delete Shift:=xlUp


Worksheets("Data - Level 1").Activate

Do Until IsEmpty(ActiveCell)

V2 = 0



Do Until IsEmpty(ActiveCell)


Range("A2").Select

ActiveCell.Offset(L1, 0).Select

'Range("A3").Select

ActiveCell.Range("A1:CA1").Select

Selection.Copy


Worksheets("Data - Level 2").Activate

Range("A2").Select

ActiveCell.Offset(L2, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Worksheets("Data - Level 1").Activate

Range("A2").Select
ActiveCell.Offset(L1, 79 + V2).Select

ActiveCell.Range("A1:C1").Select

Selection.Copy

Worksheets("Data - Level 2").Activate

Range("A2").Select
ActiveCell.Offset(L2, 79).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

L2 = L2 + 1

V2 = V2 + 3

Worksheets("Data - Level 1").Activate

Range("A2").Select

ActiveCell.Offset(L1, 80 + V2).Select

If Selection.Value = 0 Then

ActiveCell.Offset(0, 200).Select

Else

End If

Loop

L1 = L1 + 1

Range("A2").Select
ActiveCell.Offset(L1, 0).Select




Loop

Worksheets("Data - Level 2").Activate

Range("CE2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-24]"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveWindow.SmallScroll ToRight:=3
ActiveCell.Offset(-1, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RC[-3]*RC[-24]"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RC[-4]*RC[-24]"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RC[-5]*RC[-24]"
ActiveCell.Offset(1, -1).Range("A1").Select

Range("CE2:CH2").Select

Selection.Copy


Range("CE2:CH2").Select
Range(ActiveCell, ActiveCell.Offset(L2 - 1, 0)).Select



Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


'Kopier formler

Range("CI2:HI2").Select
Selection.Copy

Range("CI3").Select

Range(ActiveCell, ActiveCell.Offset(L2 - 2, 130)).Select

Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


Range("CE3").Select

Range(ActiveCell, ActiveCell.Offset(L2 - 2, 134)).Select

Selection.Copy

Range("CE3").Select

Range(ActiveCell, ActiveCell.Offset(L2 - 2, 134)).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Sheets("Styring").Select


Application.ScreenUpdating = True






End Sub
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
One thing that is very hard to do is to look at code and trying to figure out what someone is attempting to accomplish with it. Many times, there are much simpler ways of accomplishing a task, if we only know what it is that you are trying to do.

So without knowing that, I can only give general advice, which will help, but maybe not to the extent in which we could help.

First, SELECT statements slow your code down, and many times are not necessary. Most of the time, wherever you have two lines of code, where one ends in ".SELECT" and the next begins with "SELECTION" or "ACTIVECELL", those two lines can be combined together, i.e.
Code:
[COLOR=#333333]Range("CE2:CH2").Select[/COLOR]
[COLOR=#333333]Selection.Copy[/COLOR]
can be combined to:
Code:
[COLOR=#333333]Range("CE2:CH2").[/COLOR][COLOR=#333333]Copy[/COLOR]

and
Code:
[COLOR=#333333]Range("CE2").Select[/COLOR]
[COLOR=#333333]ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-24]"[/COLOR]
can be combined to:
Code:
[COLOR=#333333]Range("CE2").[/COLOR][COLOR=#333333]FormulaR1C1 = "=RC[-2]*RC[-24]"[/COLOR]

So there are many places you can improve your code there.

Also note that loops tend to be slow (and if you are selecting cells within your loop, very slow). So the key is to:
- avoid loops, if at all possible
- if you do use loops, limit the number of SELECT statements within your loop
- if you do use loops, loop through no more cells than absolutely necessary

Hopefully, that will give you a good start. If you want to explore if there are other ways of accomplishing what you are trying to do, explain your data structure and what you are trying to accomplish, in detail (maybe posting some images to assist in that explanation).
 
Upvote 0
Thanks a lot Joe, i was thinking about trying to explain the function/purpose but it is so complicated that i nearly don't understand it myself ;) Trying to explain it in another language than my own would be a daunting task.
I will try to follow your advise and look my code through. Thank you again :)
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,016
Members
448,543
Latest member
MartinLarkin

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