Das müsste eigentlich ganz einfach sein aber ich steh da auf dem Schlauch. Müsste doch eine einfache If-else und MsgBox Geschichte sein, oder?
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
Servus
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
Gruß Gerd
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
LG UweDDie erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen