Search, Copy, Insert row, Paste and Change Value

Question

I am trying to find a value "PLGDY", copy data from this row, insert a new row above the one found, paste the data into new row, replace value "PLGDY" with "PLGDN".

I wrote a macro that instead of copying data into new row it pastes into cells to the right. It also changes values in both rows to "PLGDN".

I would like to use For Next loop, because I have plenty of values to change. Is it possible to check how many values to change? I would like to use this number as counter.

 Sub Find_and_Change()
'

'Find a "PLGDY" and set an active cell
Cells.Find(What:="PLGDY", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate

'select a block of data in a row
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlToLeft)).Select
        Range(Selection, Selection.End(xlToLeft)).Select
        Range(Selection, Selection.End(xlToLeft)).Select
'copy selected block of data
        Selection.Copy
'insert a row above  active cell
        ActiveSheet.Cells(ActiveCell.Row, 1).Select
        ActiveCell.EntireRow.Insert
'set an active cell at the beginig of a row and move into column A 
        ActiveSheet.Cells(ActiveCell.Row, 1).Select
' paste copied data into this cell
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Now I select whole row
        ActiveCell.EntireRow.Select
'I need to replace PLGDY with PLGDN in this row
Selection.Replace What:="PLGDY", Replacement:="PLGDN", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'I need to move active cell 10 columns right and one row down because I want to find next PLGDY
        ActiveCell.Offset(1, 10).Select

End Sub

Answer 1

mrbungle's Answer is spot on! Works great.

For anyone finding this and intends to use this code to duplicate rows with multiple values, there is one tweak to be made. I was able to copy/paste the loop and change the variables to suit, only exception was I needed to add ActiveCell.EntireRow.Select after the ActiveCell.EntireRow.Insert otherwise when the second loop came through with the new values it replaced the original value as well as the new row was not selected. Updated code for my purposes is:

Private Sub LT2V()

Dim vCount As Integer

'Add Lesser tier of 2V
 vCount = Application.WorksheetFunction.CountIf(Range("D:D"), "2V")

Do Until vCount = 0
Cells.Find(What:="2V", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
       :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
       False, SearchFormat:=False).Activate

ActiveCell.EntireRow.Copy
ActiveCell.EntireRow.Insert
ActiveCell.EntireRow.Select

Selection.Replace What:="2V", Replacement:="1V", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

ActiveCell.Offset(1, 10).Select
vCount = vCount - 1
Loop

End Sub

Answer 2

You being new I understand you might not know all the shortcuts and built in functions. I still learn new ones all the time. In this case I used the built in worksheet function CountIf to get the number of times the values appear. Then to loop through I like to use Do Until Loop and just subtract 1 through each loop until I reach 0.

Sub Find_and_Change()


vCount = Application.WorksheetFunction.CountIf(Range("A1:Z100"), "PLGDY")

Do Until vCount = 0

    Cells.Find(What:="PLGDY", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
           :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
           False, SearchFormat:=False).Activate

    ActiveCell.EntireRow.Copy
    ActiveCell.EntireRow.Insert

    Selection.Replace What:="PLGDY", Replacement:="PLGDN", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    ActiveCell.Offset(1, 10).Select
    vCount = vCount - 1

Loop

End Sub