Mükerrer kayıt hatası

[fatihbozkurt58]

Ekte yolladığım ve aşağıda kodunu verdiğim çalışmamda kayıt yaparken eğer aynı kayıttan başka yoksa kayıt düzgün çalışıyor istediğim oluyor. Ama aynı kayıttan başka varsa kayıtı iptal edip uyarı mesajını verdikten sonra Userform5' e gitmesini istiyorum. Yardımlarınızı rica ediyorum.

Private Sub CommandButton3_Click()

Sheets("Sayfa3").Select
If TextBox1.Text = "" Then
MsgBox "İsim Girmeniz Gerekiyor"
Exit Sub
End If

Son_Dolu_Satir = Sheets("Sayfa3").Range("a65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Sayfa3").Range("A" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Sayfa3").Range("A:A")) + 1
Sheets("Sayfa3").Range("A" & Bos_Satir).Value = TextBox1.Text

MsgBox " Kayıt Tamamlandı", vbCritical
UserForm5.Show
For a = [a65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, "a")) = 1 Then
Exit Sub
End If

If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, "a")) > 1 Then Rows(a).Delete
MsgBox " Eklemek istediğiniz kişi listede var olduğu için girişiniz iptal edildi.", vbCritical, "MÜKERRER"
Next
ThisWorkbook.Save
UserForm5.Show

End Sub

 

[fireman64]

Dosyanız ektedir...

 

[fatihbozkurt58]

Teşekkür ediyorum yardımlarınız için.

 

[fireman64]

Rica ederim.

 

[simsiyahkertenkele]

merhaba arkadaşlar;

bir excel tablosunda mükerrer kayıtları otomatik silmek istiyorum, daha önceki çözümlere baktım fakat o kodların nasıl kullanılacağını bilmiyorum yardımcı olursanız sevinirim