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

i200yrs

New Member
Joined
Dec 18, 2019
Messages
22
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
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

New Member
Joined
Dec 18, 2019
Messages
22
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
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
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

i200yrs

New Member
Joined
Dec 18, 2019
Messages
22
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
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

VBA Code:
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

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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
VBA Code:
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

New Member
Joined
Dec 18, 2019
Messages
22
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
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
VBA Code:
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

New Member
Joined
Dec 18, 2019
Messages
22
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows

ADVERTISEMENT

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
VBA Code:
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

New Member
Joined
Dec 18, 2019
Messages
22
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
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

New Member
Joined
Dec 18, 2019
Messages
22
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows

ADVERTISEMENT

Below are the snapshot of the 3 sheets

Sheet1.png


Sheet2.png

Sheet3.png



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

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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 ]

VBA 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

New Member
Joined
Dec 18, 2019
Messages
22
Office Version
  1. 2019
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
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 ]

VBA 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

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
deleted by Yongle
 

Watch MrExcel Video

Forum statistics

Threads
1,127,633
Messages
5,626,007
Members
416,151
Latest member
Openminded intellectual

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top