Data extraction

[dwarek]

Hello everyone i have assigned a work in excel like find the word for example in column A i have list of words and in column B i have list of words so now i want to create a program like if i type particular word from Column A or Column B the cursor should go to that particular row where that word lies ,like vba code to find data in the worksheet... is there any vba coding for this

 

[Llupo01]

Hello Dwarek,

pls try this...you have inputbox for word you want to find. As word selected, sub will end.

Sub test2()

Dim x As String
Dim rng As Range
Dim cell As Range

Set rng = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Rows

x = InputBox("Word you want to find?", "Find")

For Each cell In rng.Resize(, 2).Cells

If Not cell.Find(x) Is Nothing Then
    cell.Select
    Exit Sub
    
End If

Next

End Sub

regards,

Tom

 

[dwarek]

Hello Tom it works perfectly thanks

 

[Peter_SSs]

Hello Tom it works perfectly thanks

Are you sure?

For the sample data below, if you enter Ann in the Input Box, then cell A2 will/may be selected, not cell B3

Excel 2010 32 bit
	A	B
1	Tom	Ian
2	Annette	Sue
3	Jim	Ann
4	Ken
5	Ted
Find word

In any case, looping through the cells 1 at a time is not efficient. I would suggest this alternative to go directly to the cell, if found.

Sub FindWord()
  Dim Wrd As String
  Dim rFound As Range
  
  Wrd = Application.InputBox("Word you want to find?", "Find")
  Set rFound = Columns("A:B").Find(What:=Wrd, After:=Range("A" & Rows.Count), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchDirection:=xlNext)
  If rFound Is Nothing Then
    MsgBox Wrd & " not found"
  Else
    Application.Goto rFound, True
  End If
End Sub

 

[Rick Rothstein]

Hello Tom it works perfectly thanks

Here is another macro that you can try...

Sub Test()
  On Error Resume Next
  Columns("A:B").Find(InputBox("Find what word?"), , , xlPart, , , False).Select
  On Error GoTo 0
End Sub

One change you might what to make is changing xlPart to xlWhole... xlPart means the text you say you want to search for can appear along with other text whereas xlWhole would mean the cell's text would have to match completely (except for letter case).

 

[dwarek]

you are right but i have a doubt when i type the text and click ok the cursor goes to the destination but i don't want the window to disappear because i don't want to click on the macro button several times to run the program i want the window to remain to be opened until i press cancel button any solution for that ? thanks

 

[Rick Rothstein]

you are right but i have a doubt when i type the text and click ok the cursor goes to the destination but i don't want the window to disappear because i don't want to click on the macro button several times to run the program i want the window to remain to be opened until i press cancel button any solution for that ? thanks

What about this...

Sub Test()
  Dim Response As Variant
  On Error Resume Next
  Do
    Response = InputBox("Find what word?")
    If Response = "" Then Exit Do
    Columns("A:B").Find(Response, , , xlPart, , , False).Select
  Loop
  On Error GoTo 0
End Sub

 

[dwarek]

this is fantastic rick thank you

 

[sai85]

you are right but i have a doubt when i type the text and click ok the cursor goes to the destination but i don't want the window to disappear because i don't want to click on the macro button several times to run the program i want the window to remain to be opened until i press cancel button any solution for that ? thanks

Hi Dwarek,

Kindly find the below code, guess it works for u:

Sub test()
Dim UserSays As String
Dim Searchword As String
On Error GoTo Handler1:
Searchword = InputBox("Enter the word you want to search")
Range("A1").Select
UserSays = "No"
Do While LCase(UserSays) = "no"
Range(ActiveCell, ActiveCell.Offset(100, 10)).Select
Selection.Find(What:="*" & Searchword & "*").Select
UserSays = InputBox("Did you search for this text? Yes/No")
ActiveCell.Offset(1, 0).Select
Loop
Exit Sub


Handler1:


MsgBox "There is no match your search criteria"
ActiveCell.Offset(-1, 0).Select
End Sub