2
\$\begingroup\$

I have a code that does a loop through a worksheets, if there is a value 2 inside a cell in column S, then I want to insert a row with a specific layout. I have the code, but it takes ages to complete. I've tried replacing .select function, but because I need a specific layout, I don't know how to avoid this.

LastRowMatchC = Worksheets("Compliance").Cells(Rows.Count, 1).End(xlUp).Row

Dim rngc As Range, rc As Long

Set rngc = Range("S8:S" & LastRowMatchC)

For rc = rngc.Count To 1 Step -1
    If rngc(rc).Value = 2 Then
        rngc(rc + 1).EntireRow.Insert
        rngc(rc + 1).EntireRow.Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    End If
Next rch 
\$\endgroup\$
1
\$\begingroup\$

When calculating your LastRowMatchC, always make sure to fully qualify ALL worksheet references like this

Worksheets("Compliance").Cells(Worksheets("Compliance").Rows.Count, 1).End(xlUp).Row

or

With Worksheets("Compliance")
    LastRowMatchC = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

(Notice the dot in front of the Rows) Otherwise, the the Rows.Count is looking at the currently active worksheet and not the one you intended.

  • Use EnableEvents and ScreenUpdating when you're making changes directly on the worksheet.

You can turn off events and screen updating before and after your loop to give a big speed boost to the reformatting:

Application.EnableEvents = False
Application.ScreenUpdating = False

For rc = rngc.Count To 1 Step -1
    '--- do your thing here
Next rc

Application.EnableEvents = True
Application.ScreenUpdating = True

(More on this in the next comment)

  • Avoid using Select and try to define any constant "magic values" in an expression. No one knows why you're looking for the value "2" here (and you may not remember a year from now). So replace the MAGIC_VALUE name with something meaningful to your application.

A partial example using your code:

Option Explicit

Sub InsertRows()
    Dim lastRow As Long
    With Worksheets("Compliance")
        lastRow = .Cells(.Rows.Count, "S").End(xlUp).Row
    End With

    Dim rngc As Range
    Set rngc = Worksheets("Compliance").Range("S8:S" & lastRow)

    AppPerformance SetTo:=False

    Const MAGIC_VALUE As Long = 2

    Dim rc As Long
    For rc = rngc.Rows.Count To 1 Step -1
        If rngc(rc).Value = MAGIC_VALUE Then
            rngc(rc + 1).EntireRow.Insert
            Dim newRow As Range
            Set newRow = rngc(rc + 1).EntireRow
            With newRow
                With .Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent1
                    .TintAndShade = 0.599993896298105
                    .PatternTintAndShade = 0
                End With
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                '--- keep going with formatting ...
            End With
        End If
    Next rc

    AppPerformance SetTo:=True

End Sub

Private Sub AppPerformance(ByVal SetTo As Boolean)
    With Application
        .EnableEvents = SetTo
        .ScreenUpdating = SetTo
    End With
End Sub
| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Thanks for the great answer @PeterT! \$\endgroup\$ – Pete Mar 4 at 15:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.