Spreadsheet getting wonky/animation delay after running a VBA script

[nightmazino]

The VBA is working fine. The VBA's purpose is to transform 4k rows of data into 12k rows. After I run the VBA, the spreadsheet starts to run terribly bad.

Like when I click some cell, it doesn't show the "active cell". Or when I click other sheets it doesn't let me see the other sheet, it does nothing. Even when clicking ribbons, it doesn't change tabs. It's like frozen. Can't even scroll too. Then after a few seconds all the actions I made, it will be applied. So it's like an animation-delay.

Then after a few minutes, it goes back to normal. Then maybe after a few minutes, it goes back to being wonky again.

Even though I delete the sheet that consists of 12k rows it still has the animation delay. Already tried disabling hardware graphics acceleration in Excel options but still the same.

Any idea why is this happening and how to fix this? I had a bigger size data set and it's not acting this way. The file is already in .xlsb format.

 

[nightmazino]

Also, I can navigate and code in the VBA window just fine even if the sheet is stuck/frozen.

 

[Michael M]

Maybe it would help if we could see the code ??
AND
Are there any worksheet events running that activate when something happens on a particualr sheet ?

 

[nightmazino]

Maybe it would help if we could see the code ??
AND
Are there any worksheet events running that activate when something happens on a particualr sheet ?

It will be hard to paste it all since it's a collection of different modules and a lot of sub-procedures that are connected together. I'll try to post some code from 1 module but it's not special. Just some looping of rows/collections, adding new sheets, copying over of new data, filtering data, etc.

Public originLocation_arr As New Collection
Public splitWS2 As Worksheet
Public parsedWS As Worksheet

Sub identifyMultiplePortNames(column As String)
'/*** Identify port names with 'slash' filter them then copy them to a new sheet ***/'
'/*** Store unique multiple port names in a collection ***/'

Dim laneLR As Long, splitLR As Long, colNum As Long
Dim cell As Range

laneLR = laneWS.Cells(Rows.Count, "A").End(xlUp).row

'filter by "/"
colNum = Range(column & 1).column
laneWS.Range("$A$4:$GK$" & laneLR).AutoFilter Field:=colNum, Criteria1:=Array("*/*"), Operator:=xlFilterValues
laneWS.Range("A4:GK" & laneLR).SpecialCells(xlCellTypeVisible).Copy

vbaWB.Sheets.Add.Name = "For Splitting"
Set splitWS = vbaWB.Sheets("For Splitting")
splitWS.Range("A1").PasteSpecial xlPasteAll

'last row
splitLR = splitWS.Cells(Rows.Count, "A").End(xlUp).row

'sort
splitWS.Sort.SortFields.Clear
splitWS.Sort.SortFields.Add Key:=splitWS.Range(column & "2:" & column & splitLR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With splitWS.Sort
    .SetRange Range("A1:GG" & splitLR)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'store unique port names in a collection
Set originLocation_arr = Nothing
For Each cell In splitWS.Range(column & "2:" & column & splitLR)

    colCount = originLocation_arr.Count
    
    If colCount = 0 Then
        originLocation_arr.Add cell.Value
    ElseIf colCount > 0 Then
        If cell.Value <> originLocation_arr(colCount) Then
            originLocation_arr.Add cell.Value
        End If
    End If

Next cell

transferPortNames (column)

splitWS.Delete
splitWS2.Delete

End Sub

Private Sub transferPortNames(column As String)
'/*** transfer (cut) identified multiple port names to a new sheet (for splitting to for splitting 2) ***/'
'/*** transfer them to parsed sheet after ***/'

vbaWB.Sheets.Add.Name = "For Splitting 2"
vbaWB.Sheets.Add.Name = "Parsed"
Set splitWS2 = vbaWB.Sheets("For Splitting 2")
Set parsedWS = vbaWB.Sheets("Parsed")
Dim portName As Variant
Dim splitLR As Long, splitLR2 As Long, splitLR3 As Long, parsedLR As Long

'last row
splitLR = splitWS.Cells(Rows.Count, "A").End(xlUp).row

'if portname is match in collection, transfer in splitting 2
For Each portName In originLocation_arr

    For i = 2 To splitLR
        
        If splitWS.Range(column & i).Value = portName Then
            splitLR2 = splitWS2.Cells(Rows.Count, "A").End(xlUp).row + 1
            splitWS.Range("A" & i & ":GG" & i).Cut splitWS2.Cells(splitLR2, "A")
        End If
    
    Next i
    
    splitPortNames (column)
    
    'cut and paste to parsed sheet the completed rows
    parsedLR = parsedWS.Cells(Rows.Count, "A").End(xlUp).row
    splitLR3 = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
    splitWS2.Range("A2:GG" & splitLR3).Cut parsedWS.Range("A" & parsedLR + 1)

Next portName

End Sub

Private Sub splitPortNames(column As String)
'/*** split port names with the slash separator and create new rows for them ***/'
'/*** all processing will be done in For Splitting 2 sheet ***/'

Dim lr As Long, lr2 As Long, lr3 As Long, itemCount As Long, slashCount As Long, slashLoc1 As Long, slashLoc2 As Long
Dim portName1 As String, portName2 As String, portName3 As String, portNameRaw As String

lr = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
itemCount = lr - 1
portNameRaw = splitWS2.Range(column & 2).Value
slashCount = Len(portNameRaw) - Len(Application.WorksheetFunction.Substitute(portNameRaw, "/", "")) 'identify how many slashes are there

If slashCount = 1 Then

    slashLoc1 = InStr(1, portNameRaw, "/") 'locate the slash
    portName2 = Mid(portNameRaw, slashLoc1 + 1, 100) 'get the right most port name
    
    splitWS2.Range("A2:GG" & lr).Copy splitWS2.Range("A" & lr + 1)
    lr2 = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
    splitWS2.Range(column & lr + 1 & ":" & column & lr2).Replace What:=portNameRaw, Replacement:=portName2, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    
    portName1 = Left(portNameRaw, slashLoc1 - 1) 'get the first port name
    splitWS2.Range(column & "2:" & column & lr).Replace What:=portNameRaw, Replacement:=portName1, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    
    Call basePortLookUp(column, portName1, lr, portName2, lr2)

ElseIf slashCount = 2 Then
    
    slashLoc1 = InStr(1, portNameRaw, "/")
    slashLoc2 = InStr(slashLoc1 + 1, portNameRaw, "/")
    
    portName2 = Mid(portNameRaw, slashLoc1 + 1, (slashLoc2 - slashLoc1) - 1) 'get the middle port name
    splitWS2.Range("A2:GG" & lr).Copy splitWS2.Range("A" & lr + 1)
    lr2 = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
    splitWS2.Range(column & lr + 1 & ":" & column & lr2).Replace What:=portNameRaw, Replacement:=portName2, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    
    portName3 = Mid(portNameRaw, slashLoc2 + 1, 100) 'get the right most port name
    splitWS2.Range("A2:GG" & lr).Copy splitWS2.Range("A" & lr2 + 1)
    lr3 = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
    splitWS2.Range(column & lr2 + 1 & ":" & column & lr3).Replace What:=portNameRaw, Replacement:=portName3, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    
    portName1 = Left(portNameRaw, slashLoc1 - 1) 'get the first port name
    splitWS2.Range(column & "2:" & column & lr).Replace What:=portNameRaw, Replacement:=portName1, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    
    Call basePortLookUp(column, portName1, lr, portName2, lr2, portName3, lr3)
    
End If

End Sub

Private Sub basePortLookUp(column As String, portName1 As String, lr1 As Long, portName2 As String, lr2 As Long, Optional portName3 As String, Optional lr3 As Long)
'/*** lookup if they exist in base port grouping sheet ***/'
'/*** if they exist, create new rows for them and remove original port names ***/'

Dim baseLR As Long, oldLR As Long, newLR As Long
Dim isMatch1 As Boolean, isMatch2 As Boolean, isMatch3 As Boolean
baseLR = Sheets("Base Port Grouping").Cells(Rows.Count, "A").End(xlUp).row

'for port name 1
For i = 3 To baseLR

    If Sheets("Base Port Grouping").Range("A" & i).Value = portName1 Then
        oldLR = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
        splitWS2.Range("A2:GG" & lr1).Copy splitWS2.Range("A" & oldLR + 1)
        newLR = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
        
        splitWS2.Range(column & oldLR + 1 & ":" & column & newLR).Replace What:=portName1, Replacement:=Sheets("Base Port Grouping").Range("D" & i).Value, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
        isMatch1 = True
    End If

Next i

If isMatch1 Then
    splitWS2.Range("A2:GG" & lr1).ClearContents
End If

'for port name 2
For i = 3 To baseLR

    If Sheets("Base Port Grouping").Range("A" & i).Value = portName2 Then
        oldLR = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
        splitWS2.Range("A" & lr1 + 1 & ":GG" & lr2).Copy splitWS2.Range("A" & oldLR + 1)
        newLR = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
        
        splitWS2.Range(column & oldLR + 1 & ":" & column & newLR).Replace What:=portName2, Replacement:=Sheets("Base Port Grouping").Range("D" & i).Value, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
        isMatch2 = True
    End If

Next i

If isMatch2 Then
    splitWS2.Range("A" & lr1 + 1 & ":GG" & lr2).ClearContents
End If

'for port name 3
If portName3 <> "" And lr3 <> 0 Then

    For i = 3 To baseLR
    
        If Sheets("Base Port Grouping").Range("A" & i).Value = portName3 Then
            oldLR = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
            splitWS2.Range("A" & lr2 + 1 & ":GG" & lr3).Copy splitWS2.Range("A" & oldLR + 1)
            newLR = splitWS2.Cells(Rows.Count, "A").End(xlUp).row
            
            splitWS2.Range(column & oldLR + 1 & ":" & column & newLR).Replace What:=portName3, Replacement:=Sheets("Base Port Grouping").Range("D" & i).Value, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
            isMatch3 = True
        End If
    
    Next i
    
    If isMatch3 Then
        splitWS2.Range("A" & lr2 + 1 & ":GG" & lr3).ClearContents
    End If

End If

'delete blank rows in for splitting 2 sheet
For x = newLR To 2 Step -1
    If splitWS2.Range("A" & x).Value = "" Then splitWS2.Rows(x).Delete
Next x

End Sub

 

[Michael M]

Ok, as asked earlier....Are there any codes in the sheet modules ??

 

[nightmazino]

Ok, as asked earlier....Are there any codes in the sheet modules ??

Sorry, forgot to answer that. No, there is no code in the sheet modules nor onOpen or onChange subprocedures.