Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B5")) Is Nothing Then Exit Sub
Dim rngSuchen As Range
Dim V, R&, C%, Found&, SS$
SS = CStr(Target.Value)
Set rngSuchen = Range("B6:H500")
With rngSuchen
V = .Value
.Interior.ColorIndex = xlNone
End With
For R = 1 To UBound(V)
For C = 1 To UBound(V, 2)
If CStr(V(R, C)) = SS Then
Select Case CInt(V(R, C + 1))
Case 1
rngSuchen(R, C).Interior.ColorIndex = Cells(1, 2).Interior.ColorIndex
Case 2
rngSuchen(R, C).Interior.ColorIndex = Cells(2, 2).Interior.ColorIndex
Case 3
rngSuchen(R, C).Interior.ColorIndex = Cells(3, 2).Interior.ColorIndex
End Select
Found = Found + 1
End If
Next
Next
If Found = 0 Then
MsgBox ("Nichts gefunden")
Else
MsgBox Found & " Einträg" & IIf(Found > 1, "e", "") & " gefunden."
End If
Target.Select
End Sub