Mükerrer Kayıt Sorunu

[bdeniz_bilen]

Private Sub CommandButton4_Click() 'Ekleme yapıyoruz (Yeni kayıt yapıyoruz)
If TextBox1.Text = "" Then MsgBox "Seri Numarasını Boş Geçemezsiniz.", vbInformation, "Uyarı": TextBox1.SetFocus: Exit Sub
'Sıra numarası oluşturuyoruz
Dim sn As Long
Set sh = Sheets("Liste")
sn = sh.Cells(Rows.Count, "b").End(xlUp).Row
say = WorksheetFunction.CountA(Range("A3:A65536")) + 1
For i = 1 To say
Cells(i + 2, 1) = i
Next i
'Textboxtaki değerleri Sayfaya Yazdırıyoruz
For x = 1 To 11
Sheets("Liste").Cells(sn + 1, x + 1).Value = Controls("TextBox" & x).Value
Next
'Hücreleri boşaltıyoruz
For t = 1 To 11
Controls("TextBox" & t) = ""
Next
MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Bilgi"

'Listview1 e veri çekiyoruz
Unload UserForm1
UserForm1.Show
'İşlemin tamamlandığını bildiriyoruz
End Sub


yukarıdaki şekilde userform ile kayıt gerçekleştiriyorum. Ancak textbox5, "F" sütunundaki mükerrer kayıtları önlemek istiyorum. Ancak bir türlü olmadı. Ya mükerrer kaydı buldu ama normal kayıtta listview' e veriyi ekledi, çıktığım anda uyarı yapıp veriyi sildi. Ya da mükerrer kayıt olmadığı durumlarda listview'e veriyi getirmedi. Galiba formülün uygulanması için yanlış yere yazıyorum.

 

[bdeniz_bilen]

Sorunu çözdüm.


Private Sub CommandButton4_Click() 'Ekleme yapıyoruz (Yeni kayıt yapıyoruz)
Dim k As Range
Set k = Range("F3:F65536").Find(TextBox5.Value, , xlValues, xlWhole)
If Not k Is Nothing Then
MsgBox "BU DEMİRBAŞ NUMARASI MEVCUT!"
Exit Sub
End If
If TextBox1.Text = "" Then MsgBox "Seri Numarasını Boş Geçemezsiniz.", vbInformation, "Uyarı": TextBox1.SetFocus: Exit Sub
'Sıra numarası oluşturuyoruz
Dim sn As Long
Set sh = Sheets("Liste")
sn = sh.Cells(Rows.Count, "b").End(xlUp).Row
say = WorksheetFunction.CountA(Range("A3:A65536")) + 1
For i = 1 To say
Cells(i + 2, 1) = i
Next i
'Textboxtaki değerleri Sayfaya Yazdırıyoruz
For x = 1 To 11
Sheets("Liste").Cells(sn + 1, x + 1).Value = Controls("TextBox" & x).Value
Next
'Hücreleri boşaltıyoruz
For t = 1 To 11
Controls("TextBox" & t) = ""
Next
MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Bilgi"

'Listview1 e veri çekiyoruz
Unload UserForm1
ThisWorkbook.Save
UserForm1.Show
'İşlemin tamamlandığını bildiriyoruz
End Sub


Bu şekilde halloldu.

 

[bdeniz_bilen]

Sorunu çözdüm.


Private Sub CommandButton4_Click() 'Ekleme yapıyoruz (Yeni kayıt yapıyoruz)
Dim k As Range
Set k = Range("F3:F65536").Find(TextBox5.Value, , xlValues, xlWhole)
If Not k Is Nothing Then
MsgBox "BU DEMİRBAŞ NUMARASI MEVCUT!"
Exit Sub
End If
If TextBox1.Text = "" Then MsgBox "Seri Numarasını Boş Geçemezsiniz.", vbInformation, "Uyarı": TextBox1.SetFocus: Exit Sub
'Sıra numarası oluşturuyoruz
Dim sn As Long
Set sh = Sheets("Liste")
sn = sh.Cells(Rows.Count, "b").End(xlUp).Row
say = WorksheetFunction.CountA(Range("A3:A65536")) + 1
For i = 1 To say
Cells(i + 2, 1) = i
Next i
'Textboxtaki değerleri Sayfaya Yazdırıyoruz
For x = 1 To 11
Sheets("Liste").Cells(sn + 1, x + 1).Value = Controls("TextBox" & x).Value
Next
'Hücreleri boşaltıyoruz
For t = 1 To 11
Controls("TextBox" & t) = ""
Next
MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Bilgi"

'Listview1 e veri çekiyoruz
Unload UserForm1
ThisWorkbook.Save
UserForm1.Show
'İşlemin tamamlandığını bildiriyoruz
End Sub


Bu şekilde halloldu.

Şöyle bir sıkıntım oluştu; mükerrer kayıtları uyarıyor ancak kaydı boş bırakırsam da uyarıyor. Boş geçersem uyarmasını istemiyorum. Yardımcı olur musunuz?

 

[bdeniz_bilen]

Yardımcı olacak kimse yok mu?

 

[bdeniz_bilen]

Şöyle bir sıkıntım oluştu; mükerrer kayıtları uyarıyor ancak kaydı boş bırakırsam da uyarıyor. Boş geçersem uyarmasını istemiyorum. Yardımcı olur musunuz?

Yardımlarınızı bekliyorum.