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

Colin Fluegel Colin Fluegel · Accepted Answer · 2015-07-20T13:19:26

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.Selectafter 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

Search, Copy, Insert row, Paste and Change Value

2 Answers