restrict search to column A

[weparle]

i would like the code to only search column A of my data page.

Sub FindStrings()
Dim FirstCell As Range, NextCell As Range
Dim stringToFind As String
Dim NextRow As Long
Dim Column As Long
' Show an input box and return the entry to a variable.
stringToFind = _
Application.InputBox("Enter Keyword", "Search Treatment")
' Set an object variable to evaluate the Find command.
Set FirstCell = Cells.Find(what:=stringToFind, _
lookat:=xlPart, _
searchdirection:=xlNext)
' If the string is not found, show this message box.
NextRow = 0
If FirstCell Is Nothing Then
MsgBox "Search Value Not Found.", vbExclamation
Else
Set NextCell = FirstCell
Do
' Otherwise, find the next occurrence of the search text.
Set NextCell = _
Cells.FindNext(NextCell)
If Not NextCell Is Nothing And _
FirstCell.Address <> NextCell.Address Then

NextRow = NextRow + 1
Worksheets("Results").Cells(NextRow + 1, "A").Value = NextCell
Worksheets("Results").Cells(NextRow + 1, "B").Value = NextCell.Offset(0, 1).Value
Worksheets("Results").Cells(NextRow + 1, "C").Value = NextCell.Offset(0, 2).Value
Worksheets("Results").Cells(NextRow + 1, "D").Value = NextCell.Offset(0, 3).Value
Worksheets("Results").Cells(NextRow + 1, "E").Value = NextCell.Offset(0, 4).Value
Worksheets("Results").Cells(NextRow + 1, "F").Value = NextCell.Offset(0, 5).Value
End If
Loop Until NextCell Is Nothing Or _
FirstCell.Address = NextCell.Address
End If
End Sub

[XLGibbs]

[VBA]
Sub FindStrings()

Dim stringToFind As String
Dim ws As Worksheet, rngLook As Range, rngFound As Range, rngFirst As Range, rngDest As Range
Dim wsDest As Worksheet

Set ws = Sheets("Sheet1")
Set wsDest = Sheets("Results")
Set rngDest = wsDest.Cells(65536, 1).End(xlUp).Offset(1, 0) 'first empty row on dest sheet column A

Set rngLook = ws.Range("A:A")

' Show an input box and return the entry to a variable.
stringToFind = Application.InputBox("Enter Keyword", "Search Treatment")
' Set an object variable to evaluate the Find command.

Set rngFound = rngLook.Find(what:=stringToFind)

If Not rngFound Is Nothing Then
Set rngFirst = rngFound
Do
Set rngFound = rngLook.FindNext(rngFound)
rngFound.Resize(1, 6).Copy
rngDest.PasteSpecial (xlPasteValues)
Set rngDest = rngDest.Offset(1) 'set the destination to 1 row down
Loop Until rngFound.Address = rngFirst.Address
Else
' If the string is not found, show this message box.
MsgBox "match not found"

End If
End Sub



[/VBA]

This does what you are looking to do.

But in your code, you are doing a search using cells.Find(...)

This tells it to look in every celll, you could just change your code to:
..Sheets("Sheet1").Range("A:A").Find(...)

[weparle]

Thx, for your help but im getting a runtime error

[XLGibbs]

Thx, for your help but im getting a runtime error

On which part? did you change the sheet names to the correct reference?

The code worked on my test just fine.

[weparle]

i took out declarations such as w=.... and input the actual sheet name. can you help me with the multiple string problem I have. i would like to put in multiple words (that are is not a phrase) w/o having to restart the program

[XLGibbs]

Well the declarations and object references were to simplify the code, all you had to do was change the name referenced if need be. Multiple strings?

What you can do is make this a procedure that accepts a variable passed to it, and run the search like a function
Sub FindStrings( str as string)

Dim stringToFind As String
Dim ws As Worksheet, rngLook As Range, rngFound As Range, rngFirst As Range, rngDest As Range
Dim wsDest As Worksheet

Set ws = Sheets("Sheet1")
Set wsDest = Sheets("Results")
Set rngDest = wsDest.Cells(65536, 1).End(xlUp).Offset(1, 0) 'first empty row on dest sheet column A

Set rngLook = ws.Range("A:A")

strToFind = str 'set the str variable passed
' Set an object variable to evaluate the Find command.

Set rngFound = rngLook.Find(what:=stringToFind)

If Not rngFound Is Nothing Then
Set rngFirst = rngFound
Do
Set rngFound = rngLook.FindNext(rngFound)
rngFound.Resize(1, 6).Copy
rngDest.PasteSpecial (xlPasteValues)
Set rngDest = rngDest.Offset(1) 'set the destination to 1 row down
Loop Until rngFound.Address = rngFirst.Address
Else
' If the string is not found, show this message box.
MsgBox "match not found"

End If
End Sub

Sub GetStringVar()
' Show an input box and return the entry to a variable.
stringToFind = Application.InputBox("Enter Keyword", "Search Treatment")

'call the function
FindStrings( strToFind)
End Sub

[weparle]

I dont understand your last entry, it seems like two different programs. how could i have the code run w. multiple variables input at the same time

[XLGibbs]

First things first...does my original code do the trick for 1 search string for you?

If so, I presume you NOW mean search for two different things at the same time?

You can try having the stringToFind be "part1*part2",that is, have 1 string, but include an asterisk between the two parts.

[weparle]

this want im using. im getting an error the reads " 400" with a red X. i was receiving this error before so i change the resize to 1,5 from 1,6



Sub FindStringspremium()
Dim stringToFind As String
Dim ws As Worksheet, rngLook As Range, rngFound As Range, rngFirst As Range, rngDest As Range
Dim wsDest As Worksheet

Set rngDest = Worksheets("Results").Cells(65536, 1).End(xlUp).Offset(3, 0)
'first empty row on dest sheet column A

Set rngLook = Worksheets("Parfitt_Standard").Range("A:A")

' Show an input box and return the entry to a variable.
stringToFind = Application.InputBox("Enter Keyword", "Search Treatment")
' Set an object variable to evaluate the Find command.

Set rngFound = rngLook.Find(what:=stringToFind, _
lookat:=xlPart1 * Part2, _
searchdirection:=xlPrevious)

If Not rngFound Is Nothing Then
Set rngFirst = rngFound
Do
Set rngFound = rngLook.FindNext(rngFound)
rngFound.Resize(1, 5).Copy
rngDest.PasteSpecial (xlPasteValues)
Set rngDest = rngDest.Offset(1) 'set the destination to 1 row down
Loop Until rngFound.Address = rngFirst.Address
Else
' If the string is not found, show this message box.
MsgBox "match not found"

End If
End Sub

[XLGibbs]

that is because there is no such thing as xlpart1 * xpart2 and that isn't what I meant for you to do.

I should have been more clear. Let's say you want to find "help" and "me"

[VBA]
stringToFind = "help*me"

Set rngFound = rngLook.Find(what:=stringToFind)
[/vba]

When I responded before I used stringToFind = part1*part2 and I should have specified that part1 and part2 are the strings to search for and that the * is part of the stringToFind.


How you get the two words into the string is up to you...

You also changed the offset of the rngDest. It should be only (1) if you want the 1st empty row. By setting it to .Offset(3) you are making three rows empty (which is okay if that is your intent).

The error had absolutely nothing to do with the resize, and if it did, changing it from 1,6 to 1,5 wouldn't change the error. It is 1,6 since your original code specified columns A:F to copy (6 columns). The resize is resize(#rows,#columns) syntax, so I said resize to 1 row by 6 columns.

[weparle]

ok, i understand. yeah, i agree the error is weird but it went away once I changed the resize--strange. It work fine now. thx a ton