VBA criteria search for string paste rows to sheet

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

amitami67

Thread Starter
Joined
Dec 7, 2020
Messages
2
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
 
Joined
Sep 4, 2003
Messages
4,916
Why is your variable LSearchValue wrapped in quotes here?

Code:
If InStr(1, Range("G" & CStr(LSearchRow)).Value, "LSearchValue") > 0 Then
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Members online

Top