Deleting/Inserting Row Takes 3 Seconds Per

[vahnx]

If I delete say 5 rows, then insert 3 rows, it would take a total of 24 seconds. If I delete just 2 rows, it will take 6 seconds. No matter what I do in this database, either by using Cells.Insert Cells.EntireRow.Delete or manually inserting/deleting, it is taking a whole 3 seconds per row. I'm not sure what I did so differently today in my database but in case it matters, it is 16855 rows in size and CW columns wide. It was fine until today!

 

[doubledaffy]

Try turning off automatic calculations, deleting/inserting the rows, and then turning it back on if you want.

 

[vahnx]

No luck.

I noticed the data does delete instantly or rows insert instantly, it lags afterwards.

Attempted to insert 6000 rows and left it for an hour and it was still "hard at work".

 

[vahnx]

It's this module that is causing the lag (strange it never used to, nothing was added).

' ****************************************************************
' *** WHEN A VALUE IS CHANGED, THE FOLLOWING CODE IS TRIGGERED ***
' ****************************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bgcol As Integer

        On Error GoTo errhandler:
        
        For Each c In Target
        bgcol = c.Interior.ColorIndex

        If bgcol = 4 Then                                           ' Standard
            If Not c.Value = "" And IsNumeric(c.Value) Then         ' Makes sure not null and numeric
                Select Case Cells(c.Row, 7)
                Case "SF45":
                    If (c.Value <= 0.764 Or c.Value >= 0.932) Then  ' FAIL
                        'c.Interior.ColorIndex = 3
                        'c.Font.Bold = True
                        Debug.Print Cells(c.Row, 2), "Fail"
                    ElseIf (c.Value > 0.764 And c.Value <= 0.792) Or (c.Value >= 0.904 And c.Value < 0.932) Then   ' WARNING
                        'c.Interior.ColorIndex = 45
                        'c.Font.Bold = True
                        Debug.Print Cells(c.Row, 2), "Warning"
                    Else
                        Debug.Print Cells(c.Row, 2), "Pass"
                    End If
                Case "SG40":
                    If (c.Value <= 0.91 Or c.Value >= 1.042) Then   ' FAIL
                        'c.Interior.ColorIndex = 3
                        'c.Font.Bold = True
                        Debug.Print Cells(c.Row, 2), "Fail"
                    ElseIf (c.Value > 0.91 And c.Value <= 0.932) Or (c.Value >= 1.02 And c.Value < 1.042) Then   ' WARNING
                        'c.Interior.ColorIndex = 45
                        'c.Font.Bold = True
                        Debug.Print Cells(c.Row, 2), "Warning"
                    Else
                        Debug.Print Cells(c.Row, 2), "Pass"
                    End If
                Case "SJ53":
                    If (c.Value <= 2.493 Or c.Value >= 2.781) Then   ' FAIL
                        'c.Interior.ColorIndex = 3
                        'c.Font.Bold = True
                        Debug.Print Cells(c.Row, 2), "Fail"
                    ElseIf (c.Value > 2.493 And c.Value <= 2.541) Or (c.Value >= 2.733 And c.Value < 2.781) Then   ' WARNING
                        'c.Interior.ColorIndex = 45
                        'c.Font.Bold = True
                        Debug.Print Cells(c.Row, 2), "Warning"
                    Else
                        Debug.Print Cells(c.Row, 2), "Pass"
                    End If
                Case "SN50":
                    If (c.Value <= 8.15 Or c.Value >= 9.23) Then   ' FAIL
                        'c.Interior.ColorIndex = 3
                        'c.Font.Bold = True
                        Debug.Print Cells(c.Row, 2), "Fail"
                    ElseIf (c.Value > 8.15 And c.Value <= 8.33) Or (c.Value >= 9.05 And c.Value < 9.23) Then   ' WARNING
                        'c.Interior.ColorIndex = 45
                        'c.Font.Bold = True
                        Debug.Print Cells(c.Row, 2), "Warning"
                    Else
                        Debug.Print Cells(c.Row, 2), "Pass"
                    End If
                End Select
            End If
        ElseIf Cells(Target.Row, 50).Interior.ColorIndex = -4142 Then   ' Auto bolden
            If Cells(Target.Row, 50) >= 1 Then                          ' If final grade is big
                Cells(Target.Row, 50).Font.Bold = True                  ' Bolden it
            Else                                                        ' Under 1
                Cells(Target.Row, 50).Font.Bold = False                 ' No boldness
            End If
        End If
        Next c
        
errhandler:
    Exit Sub
End Sub

 

[Jerry Sullivan]

Hello vahnx,

The code you have is stepping through every Cell that is in the range Target.
You probably intended that so that if you pasted several values into Column B,
it would run your Pass/Fail test on each changed Cell in Column B for each Row.

However what is happening is when you delete an entire row, Target contains all the Cells in that Row
(16,384 for xl2007), and your code is looping through each one.
You can do the math for 6000 Rows!

One way to avoid this would be Exit the Sub if
Target.Cells.Count > 1 or some other maximum number.

Another approach would be to narrow the Target down to the subset of Cells you are interested in.
Any other Cells in Target won't be part of the For Each...Next Loop.

The code could start like this to only look at changes to Cells in Column B...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bgcol As Integer
    Dim rTargetSubset As Range, c As Range
    Set rTargetSubset = Range("B:B")
    
    If Intersect(Target, rTargetSubset) Is Nothing Then Exit Sub
    Set rTargetSubset = Intersect(Target, rTargetSubset)
       
    For Each c In rTargetSubset
        bgcol = c.Interior.ColorIndex
        '...your code continues...