My Macro has slowed considerably recently

RHB

Board Regular
Joined
Feb 11, 2010
Messages
73
I have text that is copied to a worksheet called "Master" which has formulae to extract the data from Cells L1:GX5000. It doesn't often use 5000 rows but that is dependent on how much is on the web page being copied to the Master sheet.
When the Macro fires it copies this data to another worksheet which is given a name as appears in L1 cell plus it clears everything from the Master sheet ready for the next web page to be copied and pasted.
Then the process begins all over again.
The Macro used to take about 8-9 seconds to do this but recently it's taking 28-29 seconds but I can't work out why all of a sudden.
Logic tells me it's not the code as it would have been behaving like this all of the time???
Could someone please have a look and see what they think of the code and maybe a way to speed it up please.
VBA Code:
Sub Create()
    Dim ws As Worksheet
    Sheets("Form").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 1).Value = _
    Sheets("Master").Range("L1").Value
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set wh = Worksheets(ActiveSheet.Name)
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    If wh.Range("L1").Value <> "" Then
    ActiveSheet.Name = wh.Range("L1").Value
    End If
    wh.Activate
    Range("A1:K3000").ClearContents
    Range("A1").Select
    Sheets("Master").Range("A1").Select
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub[CODE=vba]
[/CODE]

I hope this code has formatted properly, oh and I did not write the code, not clever enough for that.
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,877
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
If you do a CTRL + End, where does to cursor go to ??
I'm guessing your imported data might be adding worksheet bloat. Has the file size increased as well ??
 

RHB

Board Regular
Joined
Feb 11, 2010
Messages
73
You could be onto it I think
CTRL+ End goes to cell IL56766 and file size was 18.0 Mb and is now 49.1 Mb.
Not sure how that has happened as any sheets generated by that code are deleted when the file is used again next or following days>
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,877
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Try running this code on your workbook.....Save, close .
See if the file size changes
VBA Code:
Sub MM2()
    Dim x As Long, LastRow As Long, LastCol As Long
    Application.ScreenUpdating = False
    On Error Resume Next
    For x = 1 To Sheets.Count
        With Sheets(x)
            LastRow = .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
            LastCol = .Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
            .Range(.Cells(1, LastCol + 1), .Cells(Rows.Count, Columns.Count)).Delete
            .Range(.Cells(LastRow + 1, 1), .Cells(Rows.Count, Columns.Count)).Delete
        End With
    Next x
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub
 
Solution

RHB

Board Regular
Joined
Feb 11, 2010
Messages
73

ADVERTISEMENT

The file is now 50.0 Mb
 

RHB

Board Regular
Joined
Feb 11, 2010
Messages
73
Sorry , I didn't save and close....it is 46.5 Mb....sorry about that
 

RHB

Board Regular
Joined
Feb 11, 2010
Messages
73

ADVERTISEMENT

BUT it now does the work in 13 seconds
 

RHB

Board Regular
Joined
Feb 11, 2010
Messages
73
Thank you for your exceptional help with this...I don't really understand what you did but assume it has deleted unwanted "stuff" from the worksheet.
If so, do you suggest I run that code from time to time?
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,877
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Yes...Anytime you are importing data, I'd suggest having a cleanup occasionally
VBA Code:
Sub Create()
Dim ws As Worksheet, lr As Long
Sheets("Form").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 1).Value = _
Sheets("Master").Range("L1").Value
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
Set ws = ActiveSheet
ws.Copy After:=Worksheets(Sheets.Count)
    If ws.Range("L1").Value <> "" Then
        ActiveSheet.Name = ws.Range("L1").Value
    End If
ws.Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:K" & lr).ClearContents
Sheets("Master").Activate
Range("A1").Select
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
 

RHB

Board Regular
Joined
Feb 11, 2010
Messages
73
Exceptional. Thank you, thank you.
I see your changes and understand I think what you've done.
Much appreciated.
 

Forum statistics

Threads
1,140,999
Messages
5,703,639
Members
421,307
Latest member
morrden86

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