Search substring within range, report the substring found

Try:

Sub Brooke()
Dim tbl As Range, H As Range, hh As Range, v As String, tt As Range
Set tbl = Range("A2:G30000")
Set H = Range("H1").Resize(Cells(Rows.Count, "H").End(xlUp).Row)
For Each hh In H
    v = hh.Text
    For Each tt In tbl
        If InStr(tt.Value, v) > 0 Then
            hh.Offset(0, 1).Value = "X"
            GoTo GetAnother
        End If
    Next
GetAnother:
Next
End Sub