Pull text from a list if it contains specific text

[snjpverma]

If A1 is entered Tom, then all the cell values containing Tom should get updated in B1, C1, D1 and so on.

The data with names is in A3:A100 where the A1 has to be searched for and values to be pulled from.

Vlookup pulls only the first value.

Please provide formula as well as Macro suggestions.
If the macro is difficult I will go for a formula solution because I am pretty weak in VBA.

 

[snjpverma]

I think this code implements your suggestion from post 3. Test in copy of your workbook. To implement ..
1. Right click the Sheet1 name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1. (You will need to delete any existing Worksheet_Change code currently in that module)
3. Test by entering/deleting/modifying values in column A of Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim s As String
  Dim vals As Variant, ListOfNames As Variant
 
  If Target.Count = 1 And Target.Column = 1 And Target.Row > 1 Then
    Application.EnableEvents = False
    ListOfNames = Application.Transpose(Sheets("Sheet2").Range("A2", Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)).Value)
    s = Target.Value
    Target.Interior.Color = xlNone
    Target.Offset(, 2).Resize(, UBound(ListOfNames)).ClearContents
    If Len(s) > 0 Then
      If IsError(Application.Match(s, ListOfNames, 0)) Then
        vals = Filter(ListOfNames, s, True)
        If UBound(vals) = -1 Then
          Target.Offset(, 2).Value = "Error"
          Target.Interior.Color = vbRed
        Else
          Target.Offset(, 2).Resize(, UBound(vals) + 1).Value = vals
          Target.Interior.Color = 5296274
        End If
      Else
        Target.Offset(, 2).Resize(, UBound(ListOfNames)).ClearContents
      End If
    Else
      Target.Offset(, 2).Resize(, UBound(ListOfNames)).ClearContents
    End If
    Application.EnableEvents = True
  End If
End Sub

If you enter a partially correct name, the matching suggestions will appear beside it in that same row & the target cell will go green.
If a fully correct name is entered (or the cell is cleared) any names to the right will be cleared and any color removed.
If no partial match is found then the target cell will go red and "Error" will appear beside the value in that row.

Here is a screen shot where a partially correct name has been entered. the options containing that text are shown in columns C:E in this case.

Book1
	A	B	C	D	E	F
1	Name	Comments	Suggestions
2
3	Tom		Tom B	Tom M	John Tom
4
Sheet 1

Thank you Peter, I tried your code and it worked better than I had even intended. Really appreciate that you came up with the idea of giving it a color code as well.

Dont worry. I'm just trying to give you other options for what you need.

Just change this line
Range("D2").Value = ComboBox1.Value

For this:
Range("D" & Rows.Count).End(xlUp)(2).Value = ComboBox1.Value

Although I will prefer Peter's code here in this scenario due to the nature of work, I thank you with all my heart for your contribution. Your post introduced Combo Box to me which I hadn't touched before.
You guys have piqued my interest in VBA now. I will certainly try to take some time out for it and learn gradually.

 

[Peter_SSs]

You're welcome and thank you for your kind words.

 

[snjpverma]

I think this code implements your suggestion from post 3. Test in copy of your workbook. To implement ..
1. Right click the Sheet1 name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1. (You will need to delete any existing Worksheet_Change code currently in that module)
3. Test by entering/deleting/modifying values in column A of Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim s As String
  Dim vals As Variant, ListOfNames As Variant
 
  If Target.Count = 1 And Target.Column = 1 And Target.Row > 1 Then
    Application.EnableEvents = False
    ListOfNames = Application.Transpose(Sheets("Sheet2").Range("A2", Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)).Value)
    s = Target.Value
    Target.Interior.Color = xlNone
    Target.Offset(, 2).Resize(, UBound(ListOfNames)).ClearContents
    If Len(s) > 0 Then
      If IsError(Application.Match(s, ListOfNames, 0)) Then
        vals = Filter(ListOfNames, s, True)
        If UBound(vals) = -1 Then
          Target.Offset(, 2).Value = "Error"
          Target.Interior.Color = vbRed
        Else
          Target.Offset(, 2).Resize(, UBound(vals) + 1).Value = vals
          Target.Interior.Color = 5296274
        End If
      Else
        Target.Offset(, 2).Resize(, UBound(ListOfNames)).ClearContents
      End If
    Else
      Target.Offset(, 2).Resize(, UBound(ListOfNames)).ClearContents
    End If
    Application.EnableEvents = True
  End If
End Sub

If you enter a partially correct name, the matching suggestions will appear beside it in that same row & the target cell will go green.
If a fully correct name is entered (or the cell is cleared) any names to the right will be cleared and any colour removed.
If no partial match is found then the target cell will go red and "Error" will appear beside the value in that row.

Here is a screen shot where a partially correct name has been entered. the options containing that text are shown in columns C:E in this case.

Book1
	A	B	C	D	E	F
1	Name	Comments	Suggestions
2
3	Tom		Tom B	Tom M	John Tom
4
Sheet 1

The above code does a case sensitive match, but I want the match NOT to be case sensitive. Which line do I need to change?

 

[Peter_SSs]

The above code does a case sensitive match, but I want the match NOT to be case sensitive. Which line do I need to change?

This one

vals = Filter(ListOfNames, s, True)
vals = Filter(ListOfNames, s, True, 1)