All,
I thought this may be easy but I think I'm missing a trick. I'm trying to get the code below to search in column D and E and paste the results into a new sheet. I can get the code to search one column but not both.


Sub SearchForString()

    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer
    Dim MyInput As String
    
    On Error GoTo Err_Execute
    
    Application.ScreenUpdating = False
        
    'Start search in row 5
    LSearchRow = 5
    
    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 2
    
    Sheets("Sheet2").Range("A2:U500").Clear
    
    MyInput = InputBox("Enter your seach criteria and click OK. You can search in full or in part", _
    "Search Keywords", "Enter your keyword here")
    
        If MyInput = "Enter your keyword here" Or _
            MyInput = "" Then
            Exit Sub
        End If
    
    While Len(Range("B" & CStr(LSearchRow)).Value) > 0
        
        
        If InStr(Range("D:E" & CStr(LSearchRow)), MyInput) > 0 Then
            
            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            
            'Paste row into Sheet2 in next row
            Sheets("Sheet2").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            
            'Go back to Sheet1 to continue searching
            Sheets("Sheet1").Select
            
        End If
        
        LSearchRow = LSearchRow + 1
        
    Wend
    
    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select
    
    MsgBox "All matching data has been copied."
    
Application.ScreenUpdating = True
   
    Exit Sub
    
Err_Execute:
    MsgBox "An error occurred."
    
End Sub
Any help is much appreciated!