0

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
PetePwC
  • 37
  • 5
  • 3
    Welcome to SO. Delete `rngc(rc + 1).EntireRow.Select` and replace `Selection` with `rngc(rc + 1).EntireRow`. Also, check right now [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). And about speeding code, check [Speed up code](https://stackoverflow.com/a/49514930/9199828) – Foxfire And Burns And Burns Mar 04 '20 at 12:26
  • Thanks, I'll give it a try – PetePwC Mar 04 '20 at 12:37

0 Answers0