nightmazino
New Member
- Joined
- Apr 8, 2020
- Messages
- 21
- Office Version
- 2013
- Platform
- 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:
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
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
LAST MODULE I CALL IN THE MAIN SUB
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:
- When I try to open another workbook right after I ran the script, the delay also happens to that workbook
- 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
- 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
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
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