VBA Code Slowing Over Time

[Mike H]

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

 

[Andrew Fergus]

Hi Mike

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

Andrew

 

[Mike H]

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

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]

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]

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]

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:

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