How to Insert # of Rows based on Value Criteria in Column

Question

I've spent hours trying to find the right code. I already have a 'Sub going, and this is the next step in the Sub.

I have a data set where I want to insert 3 rows if Column("C:C") < 1

Further up the module, I have: Dim ws As Worksheet Set ws = Workseets("Report1")

I didn't know if I needed to set another DIM.. This is what I have so far:

'Insert 3 Blank Rows after $ Share < 1.0

With ws
    If Range("C:C").Value < "1.0" Then
    Rows.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
End With

But I'm getting the Run-Time error '13': Type Mismatch

Thanks for the help!

...and since you're inserting rows, working from the bottom up will be easier. — Tim Williams

Tim Williams Tim Williams · Accepted Answer · 2020-03-18T17:16:04

When adding or deleting rows it's best to work from the bottom of the sheet to the top:

Dim i As Long, lr As Long, ws As Worksheet

Set ws = ActiveSheet

lr = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row

For i = lr To 2 Step -1
    With ws.Cells(i, 3)
        If Len(.Value) > 0 And .Value < 1 Then
            .Offset(1, 0).Resize(3, 1).EntireRow.Insert
        End If
    End With
Next i

EDIT: for your revised description

For i = 2 To lr
    With ws.Cells(i, 3)
        If Len(.Value) > 0 And .Value < 1 Then
            .Offset(1, 0).Resize(3, 1).EntireRow.Insert
            Exit For
        End If
    End With
Next i

Dim i As Long, n As Long, lr As Long, ws As Worksheet
Dim c As Range

EDIT2: add rows above the <1 values

Set ws = ActiveSheet
Set c = ws.Cells(ws.Rows.Count, 3).End(xlUp)
Do While c.Row > 1
    If Len(c.Value) > 0 And c.Value < 1 Then
        'insert 3 rows above
        For n = 1 To 3
            c.EntireRow.Insert
            Set c = c.Offset(-1, 0) '<<adjust for added row
        Next n
        Exit Do '<< stop checking
    End If
    Set c = c.Offset(-1, 0)
Loop

How to Insert # of Rows based on Value Criteria in Column

1 Answers