Userform Mükerrer Kayıt

[unsal_]

Arkadaşlar merhaba,
Userformdan veri girişi yapıyorum.

Unload UserForm2
For d = [a65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("a2:a" & d), Cells(d, "a")) = 1 Then
Exit Sub
End If

If WorksheetFunction.CountIf(Range("a2:a" & d), Cells(d, "a")) > 1 Then Rows(d).Delete
MsgBox " Aynı kayıt daha önce yapılmış.", vbCritical, "MÜKERRER"
Next
ThisWorkbook.Save
End Sub

Bu kod ile yapıyorum.Aynı isimli personel kayıt yapıldıysa buluyor ama işlemi iptal etmiyor aynı isimden bir daha kayıt yapıyor.Nasıl bir düzenleme yapmam gerekiyor.

 

[asi_kral]

Merhaba

MsgBox " Aynı kayıt daha önce yapılmış.", vbCritical, "MÜKERRER"

Bu satırdan sonra

Exit Sub
End If

Ekleyerek dener misiniz_?
Not ben deneme yapmadım dosya olmadığı için.

 

[unsal_]

Denedim ama olmadı.Ben dosyayı yükleyip de bakarmısınız bir.

 

[asi_kral]

Merhaba
Commandbutton1 deki kodları bununla değiştirip deneyin.

Private Sub CommandButton1_Click()
Dim S1 As Worksheet
Set S1 = Sheets("GEMİLER")
gem = S1.Range("A65536").End(xlUp).Row + 1
If WorksheetFunction.CountIf(S1.Range("A2:A" & gem), TextBox1) = 0 Then
For i = 1 To 9
S1.Cells(gem, i).Value = Controls("textBox" & i).Text
Next
MsgBox "Kaydınız Yapıldı"
ListBox1.ColumnCount = 9
ListBox1.RowSource = "GEMİLER!A3:I" & S1.Range("A65536").End(xlUp).Row
ListBox1.ColumnWidths = "80;100;100;100;100;100;100;100;100"
Unload UserForm2
ThisWorkbook.Save
Else
MsgBox TextBox1 & " Bu Gemi Kaydedilmiş", vbCritical
End If
End Sub

 

[unsal_]

Sayın asi_kral,
Teşekkürler şimdi yeni bir kayıt yapmıyor.

 

[asi_kral]

Sayın asi_kral,
Teşekkürler şimdi yeni bir kayıt yapmıyor.

Kolay Gelsin.