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!
Bookmarks