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
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,434
Office Version
365
Platform
Windows
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).
 

hejredersejre

New Member
Joined
Aug 5, 2013
Messages
7
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 :)
 

Forum statistics

Threads
1,081,702
Messages
5,360,743
Members
400,595
Latest member
T_Dubs

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top