Wie kann ich die beiden Zell Adressen von doppelten Einträgen ermitteln
und an Variablen übergeben
Gruß Christian
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cnt As Long
If Target.Column > 3 And IsDate(Cells(4, Target.Column).Value) Then
If Len(Target.Value) > 0 Then
cnt = WorksheetFunction.CountIf(Range(Cells(4, Target.Column), _
Cells(Cells(Rows.Count, "D").End(xlUp).Row, Target.Column)), Target.Value)
If cnt > 1 Then MsgBox "Name schon vorhanden"
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cnt As Long
Dim var1 As String
Dim var2 As String
Dim sName As String
Dim rng As Range
If Target.Column > 3 And IsDate(Cells(4, Target.Column).Value) Then
If Len(Target.Value) > 0 Then
cnt = WorksheetFunction.CountIf(Range(Cells(4, Target.Column), _
Cells(Cells(Rows.Count, Target.Column).End(xlUp).Row, Target.Column)), Target. _
Value)
If cnt > 1 Then
MsgBox "Name schon vorhanden"
sName = Target.Value
var1 = Target.Address
Target.ClearContents
Set rng = Columns(Target.Column).Find(What:=sName, LookIn:=xlValues, Lookat:= _
xlWhole)
var2 = rng.Address
End If
End If
End If
set rng = nothing
End Sub