VBA Function Lookup Bold Bring Back Under

[anthonyexcel]

I have about 150000 rows of data like below. I would like to look up a bold value. For instance if I have New York in cell D1, I want to bring back all of the values underneath New York so it would return [TABLE="width: 87"]
<tbody>[TR]
[TD]Jay[/TD]
[/TR]
[TR]
[TD]Fred[/TD]
[/TR]
[TR]
[TD]Mary[/TD]
[/TR]
[TR]
[TD]Ted[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[/TR]
[TR]
[/TR]
</tbody>[/TABLE]
Here is what the data looks like below:

[TABLE="width: 87"]
<tbody>[TR]
[TD]Connecticut[/TD]
[/TR]
[TR]
[TD]Steve[/TD]
[/TR]
[TR]
[TD]Ray[/TD]
[/TR]
[TR]
[TD]Bob[/TD]
[/TR]
[TR]
[TD]Jimmy[/TD]
[/TR]
[TR]
[TD]New York[/TD]
[/TR]
[TR]
[TD]Jay[/TD]
[/TR]
[TR]
[TD]Fred[/TD]
[/TR]
[TR]
[TD]Mary[/TD]
[/TR]
[TR]
[TD]Ted[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[/TR]
[TR]
[TD]Maine[/TD]
[/TR]
[TR]
[TD]Sonny[/TD]
[/TR]
[TR]
[TD]Johnny[/TD]
[/TR]
[TR]
[TD]Angelo[/TD]
[/TR]
[TR]
[TD]Salvatore[/TD]
[/TR]
[TR]
[TD]Gino[/TD]
[/TR]
[TR]
[TD]California[/TD]
[/TR]
[TR]
[TD]Gus[/TD]
[/TR]
[TR]
[TD]Dave[/TD]
[/TR]
[TR]
[TD]Ken[/TD]
[/TR]
[TR]
[TD]Ralph[/TD]
[/TR]
[TR]
[TD]George[/TD]
[/TR]
[TR]
[TD]Manny[/TD]
[/TR]
</tbody>[/TABLE]

 

[DanteAmor]

I guess the data is in column A and that you are going to put the value in D1.
Try this:

Sub Lookup_Bold()
  Dim v As Range, f As Range, i As Long
  Set v = Range("[COLOR=#0000ff]D1[/COLOR]")
  If v.Value = "" Then
    MsgBox "Put value"
    Exit Sub
  End If
  Range(v.Offset(1), Cells(Rows.Count, v.Column)).ClearContents
  Set f = Columns("[COLOR=#0000ff]A[/COLOR]").Find(v, , xlValues, xlWhole)
  If Not f Is Nothing Then
    For i = f.Row + 1 To Cells(Rows.Count, f.Column).End(xlUp).Row
      If Cells(i, f.Column).Font.Bold Then Exit For
      Cells(Rows.Count, v.Column).End(xlUp)(2) = Cells(i, f.Column)
    Next
  Else
    MsgBox "Value not exists"
  End If
End Sub

 

[anthonyexcel]

Dante worked great. Thank you so much!!! Much appreciated.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.