CODEWITHSUNDEEP
excelvba
Pulkit Khare
Pulkit Khare

Reputation: 11

I need to insert rows according to the condition

I need to insert rows according to the condition that the cell in DQ column is non-blank then I have to insert a new row, and also paste the row data in the new row data.

The problem is that I am not able to insert a row above the matched column and also I don't know how to copy the text.

Following is the code that I have:

Sub Macro()
    nr = Cells(Rows.Count, 5).End(xlDown).Row
    For r = 4 To nr Step 1
        If Not IsEmpty(Cells(r, 121).Value) Then
            Rows(r + 1).Insert Shift:=xlDown
            Rows(r + 1).Interior.ColorIndex = 16
        End If
    Next
End Sub

Upvotes: 1

Views: 161

Answers (2)

Pulkit Khare
Pulkit Khare

Reputation: 11

I actually found the answer in this forum itself. Pasting the code and the link. Thanks a lot people.

Insert copied row based on cell value

 Sub BlankLine()

    Dim Col As Variant
    Dim BlankRows As Long
    Dim LastRow As Long
    Dim R As Long
    Dim StartRow As Long

        Col = "DQ"
        StartRow = 3
        BlankRows = 1

            LastRow = Cells(Rows.Count, Col).End(xlUp).Row

            Application.ScreenUpdating = False

            With ActiveSheet
            For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) <> "" Then
.Cells(R, Col).EntireRow.Copy
.Cells(R, Col).EntireRow.Insert Shift:=xlDown
.Cells(R, Col).EntireRow.Interior.ColorIndex = 4
End If
Next R
End With
Application.ScreenUpdating = True

End Sub

Upvotes: 0

Siddharth Rout
Siddharth Rout

Reputation: 149305

For this you will have to use a reverse loop. I quickly wrote this code and it is not tested. Let me know if you get any error.

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, r As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Get the last row which has data in Col DQ
        lRow = .Cells(.Rows.Count, 121).End(xlDown).Row

        '~~> Reverse Loop
        For r = lRow To 4 Step -1
            If Not IsEmpty(.Cells(r, 121).Value) Then
                .Rows(r + 1).Insert Shift:=xlDown
                .Rows(r + 1).Interior.ColorIndex = 16
            End If
        Next
    End With
End Sub

Upvotes: 1

Related Questions