CODEWITHSUNDEEP
vbaexcel
Roman Ivanov
Roman Ivanov

Reputation: 59

Loop through row if value found copy the whole row and paste underneath/bottom row

I have spent some trying getting my code to work and looking through various example but still cant get it to work properly.

I have a table where I want to loop through all rows and if "Pro" found in column B , copy the whole row and paste it once either underneath the row or at the very bottom(ideally) (Picture attached before and after the code)

I tried with the below code but all it does is finding the first instance of "Pro" in column B and copying same row until range 50 reaches:

sub Loop()
Dim i As Long
For i = 1 To 50
Range("B" & i).Select
If Range("B" & i).Value = "Pro" Then      
Rows(i).EntireRow.Copy
Rows(i + 1).Insert Shift:=xlDown

End If
 Next i
End Sub

I tried with (For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row ) as well, defining last column but same thing happens(end up copying same row over and over again until the specified range finish).

If this will be too easy, I want for a copied row to have a value in Column A changed as well from as an exaple Req2 to Req2Pro

https://i.sstatic.net/AnWNH.jpg

Upvotes: 1

Views: 2501

Answers (2)

Winterknell
Winterknell

Reputation: 585

Run the for-next loop descending, e.g,

for row = 50 to 1 step -1
    ...
   .cells(row+1,1)=.cells(row,1) & "Pro"
next

The issue is that it finds a "Pro" and inserts a copy one row down, then advances the row counter and finds the copy. By running from the bottom up instead, the rows created have already been passed

edited to add column A update

Sub Loop()
    Dim i As Long
    For i = 50 To 1 step -1
        Range("B" & i).Select
        If Range("B" & i).Value = "Pro" Then
            Rows(i).EntireRow.Copy
            Rows(i + 1).Insert Shift:=xlDown
            Range("A" & i + 1).Value = Range("A" & i).Value & "Pro"
        End If
    Next i
End Sub

Edited to add the above

Upvotes: 1

Josh Anstead
Josh Anstead

Reputation: 348

Edit this line: 

Rows(i).EntireRow.Copy
Rows(i + 1).Insert Shift:=xlDown

With:

Rows(i + 50).Value = Rows(i).Value
Range("A" & i + 50).value =  Range("A" & i).value & "Pro"

This is it in the code:

 Sub testloop()
 Dim i As Long
 Dim Find_last_row as long
 Find_last_row = cells(rows.count,1).end(xlup).row

 For i = 1 To Find_last_row
    If Range("B" & i).Value = "Pro" Then
       Rows(i + Find_last_row).Value = Rows(i).Value
       Range("A" & i + Find_last_row).value =  Range("A" & i).value & "Pro"
    End If
 Next i
 End Sub

Upvotes: 1

Related Questions