Option Explicit
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("H12")) Is Nothing Then Exit Sub
Dim i%, j%, Pos%
Dim TS
Dim TC
On Error GoTo Fin
Application.EnableEvents = False
Range("K:K").ClearContents
TS = [Nomenclature].ListObject.DataBodyRange
ReDim TC(1, UBound(TS))
For i = 1 To UBound(TS, 1)
Pos = InStrRev(TS(i, 2), ",") + 1
If Mid(TS(i, 2), Pos, Len(TS(i, 2))) = Target.Value Then
j = j + 1
TC(1, j) = TS(i, 1)
End If
Next i
ReDim Preserve TC(1, j)
Range("K1:K" & j) = WorksheetFunction.Transpose(TC)
Fin:
Application.EnableEvents = True
End Sub