DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Integer, Data As Variant, BUL As Range, ADRES As String, Say As Integer
If Intersect(Target, Range("B2:F" & Rows.Count)) Is Nothing Then Exit Sub
Range("B:F").Interior.ColorIndex = 0
Data = Split(Trim(Target), " ")
For X = 0 To UBound(Data)
If Data(X) <> "" Then
Set BUL = Range("B:F").Find(Data(X), , , xlPart)
If Not BUL Is Nothing Then
ADRES = BUL.Address
Do
If BUL.Address <> Target.Address Then
BUL.Interior.ColorIndex = 6
Say = Say + 1
End If
Set BUL = Range("B:F").FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
End If
End If
Next
If Say > 0 Then
MsgBox "Mükerrer kayıt !", vbExclamation
End If
End Sub