Loop through a worksheet and insert a row with layout when value is true

Question

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 

Answer 1

• Always use Option Explicit and declare your variables as close as possible to their first use.

• Fully qualify your worksheet references (see #5)

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