Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then
If Target.Value = "Anton" Then MsgBox "bei Anton!", vbExclamation, "!"
If Target.Value = "Berta" Then MsgBox "bei Berta!", vbExclamation, "!"
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
For Each C In Intersect(Target, Columns("C"))
If C.Value = "Berta" Then
If Application.CountIf(Columns("C"), C) > 1 Then
MsgBox "Schon wieder Berta!°"
Exit Sub
End If
ElseIf C.Value = "Anton" Then
If Application.CountIf(Columns("C"), C) > 1 Then
MsgBox "Bitte keine heiße Asche einfüllen!°"
Exit Sub
End If
End If
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
Dim TXT As String
If Target.Column = 3 Then
If WorksheetFunction.CountIf(Columns(3), Target) > 1 Then
Select Case Target
Case "Anton": TXT = "Anton ist unbeliebt und reicht 1x"
Case "Berta": TXT = "Berta war schon da"
Case "Cäsar": TXT = "Ein Kaiser reicht in Rom"
Case Else: TXT = "schon wieder " & Target
End Select
MsgBox TXT
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End If
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub