Search a value in a column-B and return the values from column-A

[i200yrs]

Hello Excel Experts...need some help...see table below:
A B
1 Apple
2 Ball
3 Apple
4 Cat
5 Dog
I want an excel macro like if the user key-in "Apple" and click search will return values from column-A and list it in Column-C.
Like below result:
C
1
3

Hoping for usual supports...thanks

 

[i200yrs]

must be in C2:
=IF($C$1="","",IFERROR(INDEX($A$1:$A$5,SMALL(IF($B$1:$B$5=$C$1,ROW($A$1:$A$5)-ROW($A$1)+1),ROWS($C$1:C1))),"")

Yes it works.,..thanks

 

[i200yrs]

Here is my amended VBA solution which returns all results

Right click on sheet tab\ select View Code \ paste this code into the new window

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim C1 As Range, B As Range, result As Range, r As Long, addr As String
    Set C1 = Range("C1")
    Set B = Range("B1", Range("B" & Rows.Count).End(xlUp))
    r = 2
    If Not Intersect(Target, C1) Is Nothing Then
        Range("C:C").ClearContents
        C1 = InputBox("Enter string", "Text to find")
        Set result = B.Find(C1, LookIn:=xlValues)
        If Not result Is Nothing Then
            addr = result.Address
            Do
                Cells(r, "C") = result.Offset(, -1)
                r = r + 1
                Set result = B.FindNext(result)
            Loop While Not result.Address = addr
        End If
    Range("C2").Activate
    End If
End Sub

Hello,,,can you please help me modify the code, instead searching only from column B, would like to search from range B1:Z500...and instead of asking input keys,,,,would like to make a search button when click it shows the result as same in the previous code....thanks in advance

 

[Yongle]

Try this
- Values in column A are repeated if text is found in the same row more than once
- results are bow placed in column AA because your data stops at column Z

Put this code behind your button

Sub FindText()
    Dim FindText As Range, LookHere As Range, result As Range, r As Long, c As Long, addr As String
    Set FindText = Range("AA1")
    FindText.Select
    c = FindText.Column
    Set LookHere = Range("B2:Z500")
    FindText.Offset(1).Resize(Rows.Count - 1).ClearContents
    FindText.Value = InputBox("Enter string", FindText)
    Set result = LookHere.Find(FindText.text, LookIn:=xlValues)
   
    If Not result Is Nothing Then
        addr = result.Address
        r = 2
        Do
            Cells(r, c) = Cells(result.Row, "A")
            r = r + 1
            Set result = LookHere.FindNext(result)
        Loop While Not result.Address = addr
    End If
End Sub

 

[i200yrs]

Try this
- Values in column A are repeated if text is found in the same row more than once
- results are bow placed in column AA because your data stops at column Z

Put this code behind your button

Sub FindText()
    Dim FindText As Range, LookHere As Range, result As Range, r As Long, c As Long, addr As String
    Set FindText = Range("AA1")
    FindText.Select
    c = FindText.Column
    Set LookHere = Range("B2:Z500")
    FindText.Offset(1).Resize(Rows.Count - 1).ClearContents
    FindText.Value = InputBox("Enter string", FindText)
    Set result = LookHere.Find(FindText.text, LookIn:=xlValues)
  
    If Not result Is Nothing Then
        addr = result.Address
        r = 2
        Do
            Cells(r, c) = Cells(result.Row, "A")
            r = r + 1
            Set result = LookHere.FindNext(result)
        Loop While Not result.Address = addr
    End If
End Sub

YES it works....thanks a lot to you....i just removed the extra find text --> FindText.Value = InputBox("Enter string", FindText)
More blessing to you bro for helping us noobs ")

 

[i200yrs]

Try this
- Values in column A are repeated if text is found in the same row more than once
- results are bow placed in column AA because your data stops at column Z

Put this code behind your button

Sub FindText()
    Dim FindText As Range, LookHere As Range, result As Range, r As Long, c As Long, addr As String
    Set FindText = Range("AA1")
    FindText.Select
    c = FindText.Column
    Set LookHere = Range("B2:Z500")
    FindText.Offset(1).Resize(Rows.Count - 1).ClearContents
    FindText.Value = InputBox("Enter string", FindText)
    Set result = LookHere.Find(FindText.text, LookIn:=xlValues)
  
    If Not result Is Nothing Then
        addr = result.Address
        r = 2
        Do
            Cells(r, c) = Cells(result.Row, "A")
            r = r + 1
            Set result = LookHere.FindNext(result)
        Loop While Not result.Address = addr
    End If
End Sub

Hello Yongle...very sorry about this additional request...because the actual worksheet actually is like this:
I want to search a value from Worksheets("sheet1").Range("A1")
Then i will search that value from Worksheets("sheet3").Range("B2:Z500")
Then will return a values from Worksheets("sheet3").Range("A2:A500") and place it into worksheets("sheet2") start from Range("A2")

Thanks in advance ")

 

[i200yrs]

I did some modification from your

Hello Yongle...very sorry about this additional request...because the actual worksheet actually is like this:
I want to search a value from Worksheets("sheet1").Range("A1")
Then i will search that value from Worksheets("sheet3").Range("B2:Z500")
Then will return a values from Worksheets("sheet3").Range("A2:A500") and place it into worksheets("sheet2") start from Range("A2")

Thanks in advance ")

I did some modification from your original code but doesn't work. Please help...thanks

Private Sub CommandButton1_Click()
Dim FindText As Range, LookHere As Range, result As Range, r As Long, c As Long, addr As String
Set FindText = Worksheets("Sheet1").Range("A1")
FindText.Select
c = FindText.Column
Set LookHere = Worksheets("Sheet3").Range("B1:D20")
FindText.Offset(1).Resize(Rows.Count - 1).ClearContents
'FindText.Value = InputBox("Enter string", FindText)
Set result = LookHere.Find(FindText.Text, LookIn:=xlValues)

If Not result Is Nothing Then
addr = result.Address
r = 2
Do
Cells(r, c) = Cells(result.Row, "A")
r = r + 1
Set result = LookHere.FindNext(result)
Loop While Not result.Address = addr
End If
End Sub

 

[i200yrs]

Below are the snapshot of the 3 sheets

These are the codes I modified so far (but not working)


Private Sub CommandButton1_Click()
Dim FindText As Range, LookHere As Range, result As Range, r As Long, c As Long, addr As String
Set FindText = Worksheets("Sheet1").Range("AA1")
FindText.Select
c = FindText.Column

Set LookHere = Worksheets("Sheet3").Range("B1:D20")
FindText.Offset(1).Resize(Rows.Count - 1).ClearContents
'FindText.Value = InputBox("Enter string", FindText)
Set result = LookHere.Find(FindText.Text, LookIn:=xlValues)
If Not result Is Nothing Then
addr = result.Address

r = 2
Do
Cells(r, c) = Cells(result.Row, "A")
r = r + 1
Set result = LookHere.FindNext(result)
Loop While Not result.Address = addr
End If
End Sub

 

[Yongle]

Remember to use code tags when posting code - it makes it easier to read when formatted the same as in VBA editor
Code tags appear when you click on <vba/>
[ CODE=vba ] paste code here [ /CODE ]

Sub FindText()
    Dim LastCel As Range, Hunt As Range,  Found As Range, Addr As String
    With Sheets("Sheet1")
        Set Hunt = .Range("A1")
        Set LastCel = .Cells(.Rows.Count, "A")
        .Range("A2", LastCel).ClearContents
    End With
    With Sheets("Sheet3").Range("B2:Z500")
        Set Found = .Find(Hunt.text, LookIn:=xlValues)
        If Not Found Is Nothing Then
            Addr = Found.Address
            Do
             LastCel.End(xlUp).Offset(1) = Found.Offset(, -Found.Column + 1)
             Set Found = .FindNext(Found)
            Loop While Not Found.Address = Addr
        End If
    End With
End Sub

 

[i200yrs]

Remember to use code tags when posting code - it makes it easier to read when formatted the same as in VBA editor
Code tags appear when you click on <vba/>
[ CODE=vba ] paste code here [ /CODE ]

Sub FindText()
    Dim LastCel As Range, Hunt As Range,  Found As Range, Addr As String
    With Sheets("Sheet1")
        Set Hunt = .Range("A1")
        Set LastCel = .Cells(.Rows.Count, "A")
        .Range("A2", LastCel).ClearContents
    End With
    With Sheets("Sheet3").Range("B2:Z500")
        Set Found = .Find(Hunt.text, LookIn:=xlValues)
        If Not Found Is Nothing Then
            Addr = Found.Address
            Do
             LastCel.End(xlUp).Offset(1) = Found.Offset(, -Found.Column + 1)
             Set Found = .FindNext(Found)
            Loop While Not Found.Address = Addr
        End If
    End With
End Sub

This working...but Sorry for not not clear...i want the result to be placed in Worksheets("Sheet2") started in Range("D5")
Thanks

 

[Yongle]

deleted by Yongle