Animation delay/lag after running VBA script

nightmazino

New Member
Joined
Apr 8, 2020
Messages
21
Office Version
  1. 2013
Platform
  1. Windows
I have a code wherein it automates manual processes to transform a 4k row dataset into 38k rows that can be fed into a system.

Main problem: After I finish running the code (takes 6 mins) I experience animation delay (which doesn't happen before running the script). 1 specific example is when I try to apply autofilter. I need to click on cells before the autofilter icon rows on column headers appear. Also when I try to "fit to columns" it takes a few seconds before it gets applied. Sometimes, even clicking on cells are delayed.

Observations:
  1. When I try to open another workbook right after I ran the script, the delay also happens to that workbook
  2. When I try to close the workbook right after I ran the script (without closing the whole Excel app) and then open the same workbook again, it still has the delay
  3. When I try to close the whole Excel app right after I ran the script and save the workbook then open the file again, the delay disappears and the workbook functions normally now
Steps I already took:

Based on one of the recommendations I got, I cleared all the objects declared in my VBA script. It helped a bit but the delay is still there. I tried to watch all the object variables I have and check all of them before ending the main sub to see if they are really cleared. Here's what I got:
I also add the
VBA Code:
Application.CutCopyMode = False
line since I copy a lot of ranges and it helped a bit in terms of the running time but the problem still persists.

Also, I already disabled the graphic acceleration setting in the options menu.

VBA Code:

My code consists of a Main sub calling more subs in different modules. I'll just try to post the main sub and subs from 1 module

MAIN SUB
VBA Code:
Public inputWB As Workbook
Public vbaWB As Workbook
Public laneWS As Worksheet
Public conversionWS As Worksheet
Public basePortWS As Worksheet
Public splitWS As Worksheet

Sub main()
Dim laneLR As Long, parsedLR As Long
Dim startTime As Double, minutesElapsed
Dim rngName As Name

startTime = Timer

With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        .EnableAnimations = False
        .Calculation = xlAutomatic
End With

FileOpenDialogBox
setWB

'copy base port grouping sheet to the vba file
'inputWB.Sheets("Base Port Grouping").Copy After:=vbaWB.Sheets("Conversion")
inputWB.Sheets("Lane Details").Copy After:=vbaWB.Sheets("Conversion")
setWS 'declare ws variables
inputWB.Close
Set inputWB = Nothing

'delete name ranges
On Error Resume Next
For Each rngName In Names
    vbaWB.Names(rngName.Name).Delete
Next
Set rngName = Nothing
On Error GoTo 0

'/*** PHASE 1 - PARSING OF MULTIPLE PORT NAMES ***/'
identifyMultiplePortNames ("F") 'parse origin location rows with multiple port names
transferParsedToLane 'delete filtered rows in lane details with multiple port names
identifyMultiplePortNames ("I") 'parse destination location rows with multiple port names
transferParsedToLane

'/*** PHASE 2 - TRANSPOSING OF NOMINATIONS ***/'
deleteNominationSummary
getLatestBAF
transposeNomination

laneWS.Delete
Set laneWS = Nothing
ph2WS.Rows("4:1048576").ClearFormats

identifyCommodityType

Set ph2WS = Nothing
Set vbaWB = Nothing

'basePortWS.Delete

Application.CutCopyMode = False

With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
        .EnableAnimations = True
End With

minutesElapsed = Format((Timer - startTime) / 86400, "hh:mm:ss")

MsgBox "Done! The script took " & minutesElapsed & " minute(s) to complete"

End Sub

LAST MODULE I CALL IN THE MAIN SUB
VBA Code:
Sub identifyCommodityType()
'/*** fill out commodity type ***/'

Dim delColStart As Variant, delColEnd As Variant, bafCol As Variant
Dim commCol As Long, ph2LR As Long

ph2LR = ph2WS.Cells(Rows.Count, "E").End(xlUp).row

'delete columns between dg class and baf
delColStart = ph2WS.Rows("3:3").Find(What:="Forecast Owner(s)", After:=ph2WS.Range("A3"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).column
delColEnd = ph2WS.Rows("3:3").Find(What:="Updated Forecast versus initial submitted in tender", After:=ph2WS.Range("A3"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).column
delColStart = columnNumberToLetter(delColStart)
delColEnd = columnNumberToLetter(delColEnd)
ph2WS.Columns(delColStart & ":" & delColEnd).Delete shift:=xlLeft

'insert commodity type column
bafCol = ph2WS.Rows("3:3").Find(What:="UNILEVER BAF PER 20FT", After:=ph2WS.Range("A3"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).column
bafCol = columnNumberToLetter(bafCol)
ph2WS.Columns(bafCol & ":" & bafCol).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ph2WS.Range(bafCol & 3).Value = "commodity_type"

'generate formula
ph2WS.Select
commCol = ph2WS.Rows("3:3").Find(What:="commodity_type", After:=ph2WS.Range("A3"), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).column
ph2WS.Cells(4, commCol).Formula = "=IFERROR(IF(AND(N4="""",I4=""REEFER""),""Food (Frozen)"",IF(N4="""",""Non-DG"",""DG"")),"""")"
ph2WS.Cells(4, commCol).AutoFill Destination:=ph2WS.Range(Cells(4, commCol), Cells(ph2LR, commCol))
ph2WS.Range(Cells(4, commCol), Cells(ph2LR, commCol)).Copy
ph2WS.Range(Cells(4, commCol), Cells(ph2LR, commCol)).PasteSpecial xlPasteValues
Application.CutCopyMode = False

transformNonDG (commCol)

'clear variables
Set delColStart = Nothing
Set delColEnd = Nothing
Set bafCol = Nothing

End Sub

Private Sub transformNonDG(colNum As Long)
'/*** copy filtered cells to new sheet ***/'
'/*** duplicate and change DG class ***/'

Dim commCol As Long, ph2LR As Long, lr1 As Long, lr2 As Long, lr3 As Long, lr4 As Long
Dim nondgWS As Worksheet

ph2LR = ph2WS.Cells(Rows.Count, "E").End(xlUp).row

Sheets.Add.Name = "Non-DG"
Set nondgWS = Sheets("Non-DG")

'filter by "Non-DG"
ph2WS.Select
ph2WS.Range("$A$3:$AJ$" & ph2LR).AutoFilter Field:=colNum, Criteria1:=Array("Non-DG"), Operator:=xlFilterValues
ph2WS.Range("A4:AJ" & ph2LR).SpecialCells(xlCellTypeVisible).Copy nondgWS.Range("A2") 'copy over filtered cells
Application.CutCopyMode = False
ph2WS.Range("A4:AJ" & ph2LR).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp 'delete filtered cells

'duplicate copies
nondgWS.Select
lr1 = nondgWS.Cells(Rows.Count, "E").End(xlUp).row
nondgWS.Range("A2:AJ" & lr1).Copy nondgWS.Range("A" & lr1 + 1)
Application.CutCopyMode = False
nondgWS.Range(Cells(2, colNum), Cells(lr1, colNum)).Replace What:="Non-DG", Replacement:="Other", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False

lr2 = nondgWS.Cells(Rows.Count, "E").End(xlUp).row
nondgWS.Range("A" & lr1 + 1 & ":AJ" & lr2).Copy nondgWS.Range("A" & lr2 + 1)
Application.CutCopyMode = False
nondgWS.Range(Cells(lr1 + 1, colNum), Cells(lr2, colNum)).Replace What:="Non-DG", Replacement:="Tea", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False

lr3 = nondgWS.Cells(Rows.Count, "E").End(xlUp).row
nondgWS.Range(Cells(lr2 + 1, colNum), Cells(lr3, colNum)).Replace What:="Non-DG", Replacement:="Food (Non-Perishable) i.e. Cereals & Grains", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False

ph2WS.Range("A3").AutoFilter
ph2LR = ph2WS.Cells(Rows.Count, "E").End(xlUp).row
nondgWS.Range("A2:AJ" & lr3).Copy ph2WS.Range("A" & ph2LR + 1)
Application.CutCopyMode = False

nondgWS.Delete

'clear variables
Set nondgWS = Nothing

End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
It is possible that you are leaking memory when running your macro found that EXCEL can be fairly poor at tidying up variables and releasing memory. So I suggest you look at the amount of memory that excel is using while you are running your macro. See if it the usage goes back to something like it was or is considerably more. If you find it has gobbled up a lot of memory, try putting breakpoints in to find out where you are getting the big jumps. I finally solved my problem by putting a single statement to erase a temporary variant array:
Erase temparr
 
Upvote 0

Forum statistics

Threads
1,214,590
Messages
6,120,423
Members
448,961
Latest member
nzskater

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
Back
Top