Insert row when Cell Value is Greater - excel

Question

Here is my Sheet in which i wrote this code
Sub L()
Dim rng As Range, cell As Range
Set rng = Range("P12:P1322")
For Each cell In rng
If cell.Value > 12 Then
cell.Interior.ColorIndex = 3
ActiveCell.Range(rng).Activate
Copy.selection
Range(rng).Offset(1, 0).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
'Range(rng).Offset(1).EntireRow.PasteSpecial xlPasteFormats
End If
Next cell
End Sub
I tried another code too but it was not working.
You see the red cells These cells value is greater than 12 I want to add the row with same formatting below the active row.

Answer 1

I think this should do what you want
Sub L()
Dim i As Long
With Range("P12:P1322")
For i = .Rows.Count To 12 Step -1
If .Cells(i, 1).Value > 12 Then
.Cells(i, 1).Interior.ColorIndex = 3
.Cells(i + 1, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next i
End With
End Sub
The following is significantly faster
Sub LImproved()
Dim dStart As Double
dStart = Timer
Dim i As Long
Dim lCol As Long: lCol = 16 ' column P
Dim lLastRow As Long
Dim sRows As String
With ThisWorkbook.Sheets("Sheet1")
lLastRow = .Cells(.Rows.Count, lCol).End(xlUp).Row
'lLastRow = 1322
For i = lLastRow To 12 Step -1
If .Cells(i, lCol).Value > 12 Then
sRows = sRows & i + 1 & ":" & i + 1 & ","
If Len(sRows) > 235 Then
UpdateFormats Left(sRows, Len(sRows) - 1), lCol
sRows = ""
End If
End If
Next i
If sRows <> "" Then UpdateFormats Left(sRows, Len(sRows) - 1), lCol
End With
MsgBox "Time taken: " & Format(Timer - dStart, "0.00s")
End Sub
Sub UpdateFormats(sRows As String, lCol As Long)
With ThisWorkbook.Sheets("Sheet1")
With Intersect(.Range(sRows), .Columns(lCol)).Offset(-1, 0)
.Interior.ColorIndex = 3
End With
With .Range(sRows)
.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End With
End With
End Sub