Using VBA to add a row after any row that contain a certain keyword and fill columns with data-CodePudding

I need to add a row after any row that contains the keyword "skimmer", then fill columns with the following data:

columns A and B: match the data in this column from the row above.

columns D, F, H, I, J, K with text (these will always be the same)

here is what I have so far, this is not adding rows, it seems the code is not recognizing the keyword in the excel, even know the text is there..

Sub Skimmer()
Set rng2 = Range("A1").CurrentRegion
lr4 = rng2.Cells(Rows.Count, "K").End(3).Row

For i = lr4 To 2 Step -1
    If rng2.Cells(i, 11) Like "*Skimmer*" Then
        rng2.Cells(i, 11).Offset(1).EntireRow.Insert
        rng2.Cells(i, 3).Offset(1).Resize(1, 9).Value = _
        Array("", "ColD", "", "ColF", "", "ColH", "ColI", "ColJ", "ColK")
        rng2.Cells(i, 1).Offset(1).Resize(1, 2).Value = rng2.Cells(i, 1).Resize(1, 2).Value
    End If
Next i

End Sub

CodePudding user response：

Insert Range Rows and Fill With Data

This inserts rows in the range, not entire rows i.e. any data to the right of the range, stays intact.

Compact

Sub InsertSkimmersCompact()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rng2 As Range: Set rng2 = ws.Range("A1").CurrentRegion
    Dim r As Long
    For r = rng2.Rows.Count To 2 Step -1
        If LCase(rng2.Cells(r, "K").Value) Like "*skimmer*" Then
            With rng2.Rows(r).Offset(1)
                .Insert xlShiftDown, xlFormatFromLeftOrAbove
                With .Offset(-1)
                    .Columns("A:B").Value = .Offset(-1).Columns("A:B").Value
                    .Columns("C:K").Value = Array("", "ColD", "", "ColF", _
                        "", "ColH", "ColI", "ColJ", "ColK")
                End With
            End With
        End If
    Next r

    MsgBox "Skimmer-insertion complete.", vbInformation

End Sub

Argumented

Sub InsertSkimmersTest()
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rng2 As Range:  Set rng2 = ws.Range("A1").CurrentRegion
    InsertSkimmers rng2
End Sub

Sub InsertSkimmers(ByVal rg As Range)
    
    Dim r As Long
    For r = rg.Rows.Count To 2 Step -1
        If LCase(rg.Cells(r, "K").Value) Like "*skimmer*" Then
            With rg.Rows(r).Offset(1)
                .Insert xlShiftDown, xlFormatFromLeftOrAbove
                With .Offset(-1)
                    .Columns("A:B").Value = .Offset(-1).Columns("A:B").Value
                    .Columns("C:K").Value = Array("", "ColD", "", "ColF", _
                        "", "ColH", "ColI", "ColJ", "ColK")
                End With
            End With
        End If
    Next r

    MsgBox "Skimmer-insertion complete.", vbInformation

End Sub