Macro causing workbook to lag approx 1 min after code finishes running.

[TJ_769]

Hi all,

I have an issue; when I run the code (through a UserForm) below it runs fine and ends, everything works perfectly for a few seconds and then the workbook starts to get slower and slower. If the book AutoSaves it crashes, and the display doesn't update without moving away (i.e. scrolling up or down or changing sheets).

I'm new to all of this so I'm very aware I've probably written this in some archaic way / left something running but I can't figure it out...

What I am trying to achieve is to run through a list of rows in Sheet 1, if the value in column K meets a criteria it builds a 4x4 grid of specific cells in Sheet 2 (values are taken from the lookup table, text is from the template).

E.g.
Text 1
[TABLE="width: 500"]
<tbody>[TR]
[TD]Text 1
[/TD]
[TD]Value 1
[/TD]
[TD]Text 5
[/TD]
[TD]Value 5
[/TD]
[/TR]
[TR]
[TD]Text 2
[/TD]
[TD]Value 2
[/TD]
[TD]Text 6
[/TD]
[TD]Value 6
[/TD]
[/TR]
[TR]
[TD]Text 3
[/TD]
[TD]Value 3
[/TD]
[TD]Text 7
[/TD]
[TD]Value 7
[/TD]
[/TR]
[TR]
[TD]Text 4
[/TD]
[TD]Value 4
[/TD]
[TD]Text 8
[/TD]
[TD]Value 8
[/TD]
[/TR]
</tbody>[/TABLE]

Private Sub Email_Click()
Dim i As Long
Dim x As Long
Dim lastrow
Dim Template As Range
Set Template = Range("Template")
x = 1
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet 1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet 2")
lastrow = Sheets("Open Tickets").Range("K" & Rows.Count).End(xlUp).Row
 
ws2.Columns("A:D").ClearContents
For i = 2 To lastrow
    If ws1.Cells(i, 11) = "Updated" Or ws1.Cells(i, 11) = "Initiated" Then
        
        Template.Copy Destination:=ws2.Cells(x, 1)
        ws1.Cells(i, 1).Copy Destination:=ws2.Cells(x, 2)
        ws1.Cells(i, 2).Copy Destination:=ws2.Cells(x + 1, 2)
        ws1.Cells(i, 3).Copy Destination:=ws2.Cells(x + 2, 2)
        ws1.Cells(i, 8).Copy Destination:=ws2.Cells(x + 3, 2)
        ws1.Cells(i, 5).Copy Destination:=ws2.Cells(x, 4)
        ws1.Cells(i, 9).Copy Destination:=ws2.Cells(x + 1, 4)
        ws1.Cells(i, 4).Copy Destination:=ws2.Cells(x + 2, 4)
        ws1.Cells(i, 6).Copy Destination:=ws2.Cells(x + 3, 4)
        
        x = x + 5
        Application.CutCopyMode = False
    End If
    
Next i
ws2.Columns(2).AutoFit
ws2.Columns(4).AutoFit
 
Unload Me
End Sub

Thanks in advance of anyone who can shed some light on the situation, let me know if I have omitted some useful information!

 

[jmacleary]

Hello there.

It is possible (probable) that excel thinks the lastrow of your worksheet is a looong way down - throw a

msgbox lastrow

in after where lastrow is set so you can see the last row excel thinks its got.

You can also speed it up (a bit) by adding :

application.screenupdating=false

at the start, and

application.screenupdating=true

at the end

 

[TJ_769]

Hey there,

Thanks you for this, I have checked and it is showing (correctly) that the lastrow value is 37 so not looping through the whole sheet. I have added the screen update and it has sped the calculation up (thanks for that!) but the issue still remains that the sheet slowly dies after running it. It's completely normal straight after the macro, 30 seconds in the screen lags behind what I'm doing and after a minute or so it goes completely non-responsive. If I close the book it still asks me to save and lets me do that no problem, and doesn't go into the "Not responding", just decides to go on strike...

If anyone has any suggestions they're very welcome!

 

[mukesh098]

Try to put 'DoEvents' before 'Next i':

DoEvents
Next i

 

[TJ_769]

Hey Mukesh098,

I added that in and it appeared to be working - I then went away from the book for 2 mins and it had frozen again (yet still could close / save as normal just no ability to edit the sheet).

Cheers,