VBA code to find a string in a specific column and copy the entire row to row below 1

[tyantorno]

Hello,

I am looking to write a VBA program to search a column for a particular string "Jeff" and when that string is found to copy the entire row to the row below on the same worksheet and highlight the font in red. Thank you in advance.

 

[Andrzejek]

Good for you.

When you will have some work (code) done, let us know if we can help you...

Have fun.

---- Andy

 

[SkipVought]

hi,

Can you tell us WHY you are doing this?

1) Overwriting data in an existing row and 2) Duplicating data are two things that are extremely puzzeling and very unusual.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mintjulep]

This seems essentially the same thing that you were trying to do in thread707-1696727

Why does the solution you were given there not work for you in this case too?

 

[PWD]

Hi friend, I agree with the others that you should really try to record some code and then ask for assistance. However as I had some time to kill before I went home I had a little play around to get some horrible code that may allow you to get yourself a bit further down the line.

Generally speaking you should avoid 'SELECT' statements but I just wanted to show you want you can do by recoding your steps.

Sub Macro3()
'

Dim MyFind As String
Dim MCL As String 'Column Letter

MyFind = "Jeff"
MCL = "D"

    Columns(MCL & ":" & MCL).Select
    Selection.Find(What:=MyFind, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
        ARow = ActiveCell.Row
        With Rows(ARow)
        .Copy
        .Insert Shift:=xlDown
        End With
        
            Cells.FindNext(After:=Rows(ARow)).Activate
        ARow = ActiveCell.Row
            
    Columns(MCL & ":" & MCL).Select
    
 Do Until Range(MCL & (ARow + 1)) = ""
    
    Selection.Find(What:=MyFind, After:=Range(MCL & ARow), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
        ARow = ActiveCell.Row
        With Rows(ARow)
        .Copy
        .Insert Shift:=xlDown
        End With
        
            Cells.FindNext(After:=Rows(ARow)).Activate
        ARow = ActiveCell.Row
        
Loop
        
End Sub

Many thanks,
D€$