Dear members,
I'm having a lot of trouble with this VBA code for a table that has rows starting from 341-533 and columns A-K. I'm trying to write code that enters a specific string criteria in a text box to search for a string like "rent" or "volunteer" in a multiple detailed string column like "volunteer in kenya" called description to pull up rows containing the particular part of the string and paste results to a new sheet. When i run this code, it pulls up the first criteria row only and pastes it to the new sheet leaving out the remaining rows containing that string. Why wont it take all the relevant rows?
Please correct my code and explain what i'm doing wrong. Thank you! Much appreciate
Sub SearchForString()
Dim LSearchRow As Long
Dim LCopyToRow As Long
Dim LSearchValue As String
On Error GoTo Err_Execute
LSearchValue = InputBox("Please enter a value to search for.", "Enter value")
'Start search in row 4
LSearchRow = 341
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column H = LSearchValue, copy entire row to Sheet2
If InStr(1, Range("G" & CStr(LSearchRow)).Value, "LSearchValue") > 0 Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet3 in next row
Sheets("Search Results").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
' Copy row from current sheet into Sheet3
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy Sheets("Sheet2").Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow))
'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("A341").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox Err.Description
End Sub