Mükerrer kayıt kontrolu

[kelkitli]

Değerli Dostlar Selamlar,

Sub kaydet()
'K A Y D E T
On Error Resume Next
If TextBox1.Text = "" Then
MsgBox ("LÜTFEN ADINI YAZIN"), vbCritical, ("AD BÖLÜMÜ BOŞ")
Exit Sub
ElseIf TextBox2.Text = "" Then
MsgBox ("LÜTFEN SOYADINI YAZIN"), vbCritical, ("SOYADI BÖLÜMÜ BOŞ")
Exit Sub
ElseIf TextBox4.Text = "" Then
MsgBox ("LÜTFEN KART NUMARASINI YAZIN"), vbCritical, ("KART NO BÖLÜMÜ BOŞ")
Exit Sub
ElseIf TextBox5.Text = "" Then
MsgBox ("LÜTFEN KART TİPİNİ YAZIN"), vbCritical, ("KART TİPİ NO BÖLÜMÜ BOŞ")
Exit Sub
End If
[COLOR="Red"]    Set Bul = Sayfa1.[B:B].Find(TextBox1) And Sayfa1.[C:C].Find(TextBox2)
    If Not Bul Is Nothing Then
    MsgBox "MÜKERRER KAYIT !", vbCritical, "DİKKAT !"
    Exit Sub
    End If[/COLOR]
UserForm1("TextBox1,TextBox2,TextBox3,ComboBox1").Copy
Sayfa1.Select
Son_Satır = Range("B65536").End(3).Offset(1).Row
Range("A" & Son_Satır) = Son_Satır - 1
Range("B65536").End(3).Offset(1).Select
For a = 0 To 9
ActiveCell.Offset(0, a).Value = UserForm1.Controls("Textbox" & a + 1).Value
Next a
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Application.CutCopyMode = False
MsgBox "KAYIT TAMAMLANDI"
End Sub

Yukarıdaki kodlarla mükerrer kayıt kontrolü yapmaktayım.
İstiyorum ki: Kayıt yaparken TextBox1 deki veriyi B:B veri alanında bulunca bir sağındaki hücredeki bilginin TextBox2 ye eşitliğini kontrol etsin. Eğer TextBox1 ve TextBox2 yani adı soyadı aynı ise mükerrer işlemi uygulasın.
Saygılar.

 

[Orion1]

Set Bul = Sayfa1.[B:B].Find(TextBox1)
    If Not Bul Is Nothing Then
         if bul.offset(0,1).value= textbox2.text then

 

[kelkitli]

Evren Hocam teşekkür ederim. İşlem tamamdır.

 

[Orion1]

Evren Hocam teşekkür ederim. İşlem tamamdır.

Rica ederim.
İyi çalışmalar.

 

[omeryılmaz]

Mükerrer kayıt kontrolü

Evren Hocamın Mükerrer Kayıt Kontrolü işlemini böyle bir formata nasıl uygulayabiliriz… Saygılar

 

[kelkitli]

Merhaba,

Set bul = Sayfa2.[F:F].Find(TextBox1)
If Not bul Is Nothing Then
If bul.Offset(0, 1).Value = TextBox5.Text Then

Şeklinde deneyiniz.

 

[omeryılmaz]

Set bul = Sayfa2.[F:F].Find(TextBox1)
If Not bul Is Nothing Then
If bul.Offset(0, 1).Value = TextBox5.Text Then
MsgBox "MÜKERRER KAYIT !", vbCritical, "DİKKAT !"
Exit Sub
End If

Kaydet Makrosundaki diğer kodlar işlemekte ancak üsteki mükerrer kayıt incelemesini eklediğimde
Hata Veriyor

 

[kelkitli]

Set bul = Sayfa2.[F:F].Find(TextBox4) ' F ve G sütunlarını karşılaştır..
If Not bul Is Nothing Then
If bul.Offset(0, 1).Value = TextBox5.Text Then
MsgBox "MÜKERRER KAYIT !", vbCritical, "DİKKAT !"
Exit Sub
End If
End If

 

[omeryılmaz]

Şartlı Mükerrer Kayıt konrülü

Merhaba,
'PROBLEM kaydet Butununda Mükerrer kayıt kontrolünde**********



Set bul = Sheets("ana").[d:d].Find(TextBox41) ' b ve d sütunlarını karşılaştır..
If Not bul Is Nothing Then
If bul.Offset(0, 1).Value = TextBox1.Text Then
If MsgBox(TextBox41 & " T.C. No'lu Anneye ait " & TextBox1 & " Adında Bebek kaydı Yapılmış!..." & " **Yeniden kayıt yapılsın mı?***", vbYesNo) = vbNo Then Exit Sub
' Evet ise kayıt işlemi yapılsın,
'Hayır ise kayıt iptal TextBox ve ComboBoxları temizle
End If
End If