Sütuna Birden Fazla Girilen Değeri Renklendir - Microsoft Excel

Worksheet_Change olayı ile A sütununda meydana gelen her veri değişiminde kontrol yaptırıyoruz ve eğer girilen değer önceden eklenmişse bilgi mesajı veriyor ve o sütunu renklendiriyor.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1:A1048576")) Is Nothing Then Exit Sub
        Dim son_satir As Long
        Dim x, k As Long
        
        son_satir = Range("A1048576").End(xlUp).Row
        For x = 1 To son_satir
            If WorksheetFunction.CountIf(Range("A1:A" & son_satir), Cells(son_satir, 1)) > 1 Then
                MsgBox "Bu veri daha önceden eklenmiş." & _
                vbCrLf & "Tekrarlanan veri renklendirildi."
                
                Cells(son_satir, 1).Select
                Selection.Interior.ColorIndex = 40
                Exit Sub
            Else
                Cells(son_satir, 1).Interior.Color = xlNone
            End If
        Next
End Sub

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    '--------------------------------------------------
    'Eğer Target alanı, belirlediğimiz alanla
    'kesişmiyorsa bu Worksheet_Change olayı çalışmasın.
    '--------------------------------------------------
    If Intersect(Target, Range("A1:A1048576")) Is Nothing Then Exit Sub
        Dim son_satir As Long
        Dim x, k As Long
        
        '--------------------------------------------------
        'Biz A sütununa veri ekledikçe son satır
        'bilgisi de değişeceği için bunu değişkene
        'aktarıyoruz ve dinamik hale getiriyoruz.
        '--------------------------------------------------
        son_satir = Range("A1048576").End(xlUp).Row
        
        '--------------------------------------------------
        'Worksheet_Change olayı her tetiklendiğinde
        'yeni eklenen satır da dahil olmak üzere
        'döngü çalışacak ve kontrol yapacak.
        '--------------------------------------------------
        For x = 1 To son_satir
            
            '--------------------------------------------------
            'Kontrolü CountIf fonksiyonu ile yaptırıyoruz.
            'Yani çalışma sayfasında (Worksheet) Türkçe
            'karşılığı EĞERSAY olan fonksiyon.
            '
            'Verilen alanda son girilen veri kaç tane var
            'kontrol ettiriyoruz. Eğer bu sonuç birden büyükse
            'demek ki son girilen kayıt aslında mükerrer,
            'yani tekrar eden bir kayıt.
            '--------------------------------------------------
            If WorksheetFunction.CountIf(Range("A1:A" & son_satir), Cells(son_satir, 1)) > 1 Then
                
                '--------------------------------------------------
                'Birden fazla kayıt olduğu bilgisini veriyoruz.
                '--------------------------------------------------
                MsgBox "Bu veri daha önceden eklenmiş." & _
                vbCrLf & "Tekrarlanan veri boyandı."
                
                '--------------------------------------------------
                'Son girdiğimiz verinin bulunduğu hücreyi seçtik.
                '--------------------------------------------------
                Cells(son_satir, 1).Select
                
                '--------------------------------------------------
                'Hücreyi renklendirdik.
                '--------------------------------------------------
                Selection.Interior.ColorIndex = 40
                
                '--------------------------------------------------
                'Bu noktadan itibaren kodun çalışmasına
                'gerek yok, yordamdan çıkıyoruz.
                '--------------------------------------------------
                Exit Sub
            Else
                
                '--------------------------------------------------
                'Bunun konuyla doğrudan bir alakası yok.
                'Eğer birbiri ardına aynı kaydı 5 - 10
                'defa girerseniz otomatik olarak benzersiz
                'kayıtları da boyamaya başlıyor. Bunun
                'önüne geçmek için de bu kodu ekledim.
                '--------------------------------------------------
                Cells(son_satir, 1).Interior.Color = xlNone
            End If
        Next
End Sub