VBA Code Slowing Over Time

Mike H

Active Member
Joined
Feb 15, 2006
Messages
321
Afternoon everyone!!

I have what seems quite a simple question i'm hopeing you can help me with...

I have a piece of code that i wrote a long time ago that worked really quickly when it was first written. The work book size is about the same but for some reason after about a year of usage the code is now annoying lack luster...

Is there anyway i can get it ticking over nicely like when it was first written?

What would be the reason its just slows??

Thanks guys

Mike
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Andrew Fergus

MrExcel MVP
Joined
Sep 9, 2004
Messages
5,432
Hi Mike

Can you post the code? Has anything else changed? Like the version of Office, or the PC etc?

Andrew
 

Mike H

Active Member
Joined
Feb 15, 2006
Messages
321
Hi..

The code is below... Does what i need and did it in seconds originally... The whole thing has slowed over time??

Its only a 1.5 meg file

Code:
Sub MyDualCopy()

 

'Macro To Format All Sheets Within The Report'

 

'DAILY SALES REPORT INBOUND TAB'

 

Sheets("Daily Sales Report Inbound").Select

Dim lngMySecondDataRow As Long

 

Rows("17:17").Select

Selection.Copy

Rows("18:18").Select

Selection.Insert Shift:=xlDown

Cells(17, 2) = Cells(18, 2) + 1

Application.Goto Reference:="MySecondData"

Rows(ActiveCell.Row).Select

 

lngMySecondDataRow = ActiveCell.Row

 

Selection.Copy

ActiveCell.Offset(1, 0).Select

Selection.Insert Shift:=xlDown

 

Cells(lngMySecondDataRow, "B") = Cells(18, 2) + 1

 

Range("A1").Select

 

 

'DAILY SALES REPORT GE'

 

Sheets("Daily Sales Report GE").Select

Dim lngGEdataRow As Long

 

Rows("17:17").Select

Selection.Copy

Rows("18:18").Select

Selection.Insert Shift:=xlDown

Cells(17, 2) = Cells(18, 2) + 1

Application.Goto Reference:="GEdata"

Rows(ActiveCell.Row).Select

 

lngGEdataRow = ActiveCell.Row

 

Selection.Copy

ActiveCell.Offset(1, 0).Select

Selection.Insert Shift:=xlDown

 

Cells(lngGEdataRow, "B") = Cells(18, 2) + 1

 

Range("A1").Select

 

'DAILY SALES REPORT OBTM'

 

Sheets("Daily Sales Report OBTM").Select

Dim lngOBTMdataRow As Long

 

Rows("17:17").Select

Selection.Copy

Rows("18:18").Select

Selection.Insert Shift:=xlDown

Cells(17, 2) = Cells(18, 2) + 1

Application.Goto Reference:="OBTMdata"

Rows(ActiveCell.Row).Select

 

lngOBTMdataRow = ActiveCell.Row

 

Selection.Copy

ActiveCell.Offset(1, 0).Select

Selection.Insert Shift:=xlDown

 

Cells(lngOBTMdataRow, "B") = Cells(18, 2) + 1

 

Range("A1").Select

 

 

'DAILY SALES REPORT INTERNET'

 

Sheets("Daily Sales Report Internet").Select

Dim lngcopyandpastemeRow As Long

 

Rows("17:17").Select

Selection.Copy

Rows("18:18").Select

Selection.Insert Shift:=xlDown

Cells(17, 2) = Cells(18, 2) + 1

Application.Goto Reference:="Copyandpasteme"

Rows(ActiveCell.Row).Select

 

lngcopyandpastemeRow = ActiveCell.Row

 

Selection.Copy

ActiveCell.Offset(1, 0).Select

Selection.Insert Shift:=xlDown

 

Cells(lngcopyandpastemeRow, "B") = Cells(18, 2) + 1

 

Range("A1").Select

 

'CALL REPORT INBOUND'

 

Sheets("Call Report Inbound").Select

Rows("17:17").Select

    Selection.Copy

    Rows("18:18").Select

    Selection.Insert Shift:=xlDown

    Cells(17, 2) = Cells(18, 2) + 1

    Range("A1").Select

    

'CALL REPORT INTERNET'

 

Sheets("Call Report Internet").Select

Rows("17:17").Select

    Selection.Copy

    Rows("18:18").Select

    Selection.Insert Shift:=xlDown

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

        :=False, Transpose:=False

    Cells(17, 2) = Cells(18, 2) + 1

    Range("A1").Select

    

'TOTAL ACTIVITY'

 

    Sheets("Total ASDA Activity").Select

Rows("17:17").Select

    Selection.Copy

    Rows("18:18").Select

    Selection.Insert Shift:=xlDown

    Range("R17:Am17").Select

    Selection.Copy

    Range("R18").Select

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

        :=False, Transpose:=False

    Range("B17").Select

    Selection.Copy

    Range("B18").Select

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

        :=False, Transpose:=False

    Cells(17, 2) = Cells(18, 2) + 1

    Range("A1").Select

 

 

'DAILY SALES REPORT Repeat'

 

Sheets("Daily Sales Report Repeat").Select

Dim lngRepeatdataRow As Long

 

Rows("17:17").Select

Selection.Copy

Rows("18:18").Select

Selection.Insert Shift:=xlDown

Cells(17, 2) = Cells(18, 2) + 1

Application.Goto Reference:="Repeatdata"

Rows(ActiveCell.Row).Select

 

lngRepeatdataRow = ActiveCell.Row

 

Selection.Copy

ActiveCell.Offset(1, 0).Select

Selection.Insert Shift:=xlDown

 

Cells(lngRepeatdataRow, "B") = Cells(18, 2) + 1

 

Range("A1").Select

 

Sheets("Front Sheet").Select

Range("A1").Select

End Sub
 

Andrew Fergus

MrExcel MVP
Joined
Sep 9, 2004
Messages
5,432
Hi

How long is the routine actually taking to run? Part of the reason for the speed will be (not turing off) the screen updating and the multiple selections of cells and ranges etc. The same effect can be achieved without using the select command.

What is "MySecondData"? Which worksheet is it on? And what data is contained in the nearby column B?

Andrew
 

Mike H

Active Member
Joined
Feb 15, 2006
Messages
321
Well.. In column B there is a date that changes '+ one' every time its run.

The report looks for the named range because there are 2 tables that grow day by day for the month containing data.

But because of the insert from the first part it then finds the named range and performs the same. The named range moves daily.

Application.ScreenUpdating = False.... Does this speed up the process...

I will put that in, i didn't realise this made things a little quicker..?[/code]
 

Andrew Fergus

MrExcel MVP
Joined
Sep 9, 2004
Messages
5,432
Hi

It appears "MySecondData" is a named range. Where/what exactly is this range? Is it on the same worksheet where you are inserting the new row? If so, is it above or below the new row? The reason I ask is because it is tempting to re-write the code to remove all of the 'select' statements but without knowing anything about MySecondData I won't provide a re-write for fear of breaking something.

Instead of using select / copy / paste statements, or even selecting ranges, you can do things like this instead:
Code:
With Sheets("Sheet1")
    .Cells(2, 1).Value = .Cells(1, 1).Value + 1
    MsgBox .Range("MyNamedRange").Row
End With
Maybe you could try re-writing the code using these sorts of concepts and remove every select statement. That would definitely speed things up. I am still curious as to how long this is currently taking......

Andrew
 

Watch MrExcel Video

Forum statistics

Threads
1,122,819
Messages
5,598,293
Members
414,223
Latest member
Accountant2B

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
Top