简体   繁体   中英

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

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!

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM