Enter a value in an InputBox and then search for this value in a colum

[melissadianna]

How do I write a macro that will ask the user to enter a search value in an InputBox in Sheet 1. It would then look for this string value in columns A:L in Sheet 1. If the string is found, it will copy that entire row into Sheet 2?

I would like the user to be able to type in partial text from a text string into the InputBox and still have the row returned, i.e. exact matches not required. For example, if the user types in “Support” the macro will still return the row that has “Support Frame” in it.

This is what I have so far but it does not search all columns in Sheet 1 and it does not do partial text matches.

Sub SearchForString()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
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 = 4

'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 E = LSearchValue, copy entire row to Sheet2
If Range("E" & CStr(LSearchRow)).Value = LSearchValue 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."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

 

[CajunCenturion]

You'll need another loop, either inside or outside the current loop, to search the columns. I'll put the column row on the outside.

For LSearchCol = 65 to 76
SColID = CHR(LSearchCol)
LSearchRow = 4
While Len(Range(SColID & CStr(LSearchRow)).Value) > 0
...
LSearchRow = LSearchRow + 1
Wend
next LSearchCol


For the partial searches, you can use the left and len function.

if (Left(Range("E" & CStr(LSearchRow)).Value, LenN(LSearchValue)) = LSearchValue Then

Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein

 

[IDS]

Have a look at the VBA Like operator for matching partial strings.

Alternatively record a manual search and use that as a model for using the Excel search functionality within a macro.

Doug Jenkins
Interactive Design Services

http://newtonexcelbach.wordpress.com/

 

[melissadianna]

I'm still stuck on trying to resolve this. Anyone else have a solution?

 

[IDS]

I'm still stuck on trying to resolve this. Anyone else have a solution?

It would help if you told us why the solutions offered don't do what you want.

Doug Jenkins
Interactive Design Services

http://newtonexcelbach.wordpress.com/

 

[Hoaokapohaku]

I think this will work for you:

Sub SearchForString()

Dim LSearchValue As String
Dim RefCount As Integer

    LSearchValue = InputBox("Please enter a value to search for.", "Enter value") & "*"
    RefCount = Application.WorksheetFunction.CountIf(Sheet1.Range("A:L"), LSearchValue) - 1
    Range("A1").Activate
    For Counter = 0 To RefCount Step 1
        With Columns("A:L").Find(What:=LSearchValue, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            .EntireRow.Copy Destination:=Worksheets("sheet2").Range("A1").Offset(Counter, 0)
            .Activate
        End With
    Next
End Sub

You can speed this macro up my limiting the search range to something less than the whole columns A:L, like A1:L500.

This will paste the rows beginning on Row 1 of sheet2. If you want it to start pasting on a different row, change the zero value in the counter to a number one less than the row number for the row into which you want to start pasting.

 

[Hoaokapohaku]

If you want to paste to the first empty row of sheet2, change the destination to:

Worksheets("sheet2").Range("A65536").End(xlUp).Offset(1,0)