Kayıt işlemi bittikten sonra tekrar mükerrer kayıt sorgulaması neden oluyor?

[excelicent]

Bir çalışmamda kayıt işlemine, mükerrer kayıt oluşmaması için eklediğim kod aktif çalışmakta fakat kayıt işlemi bittikten sonra tekrar mükerrer kayıt sorgulaması yapıyor. Konu hakkında yardımlarınızı rica ediyorum.

---------------

Private Sub cbEk_Click()

Application.ScreenUpdating = False

'If TextBox5000 = "" Then

If Cb1.Value = Empty Or Cb2.Value = Empty Or Cb101.Value = Empty Or Cb107.Value = Empty Or TextBox1.Value = Empty Or TextBox2.Value = Empty Or TextBox10.Value = Empty Or TextBox11.Value = Empty Or TextBox5000.Value = Empty Or TextBox5001.Value = Empty Or TextBox1001.Value = 0 Or TextBox1007.Value = 0 Or TextBox5000.Value = 0 Or TextBox5001.Value = 0 Then

MsgBox ("Eksik veri olabilir, haberin olsun."), vbCritical
Exit Sub
Else
End If

Dim bul As Range
Sheets("VERITABANI").Select
[A65536].End(xlUp).Offset(1, 0).Select
For Each bul In Range("c2:c" & Range("c65536").End(3).Row)
If bul.Value = TextBox2.Text Then
Else
If MsgBox("Aynı kayıt bulundu, yine de kaydedilsin mi?", vbYesNo, "Www ") = vbNo Then
Exit Sub

End If

Dim I As Integer
' Sayfaya özel atmak için Range önüne ekle Sheets("Veri").
Sheets("VERITABANI").Range("b65536").End(3)(2, 1) = AnaCb2
Sheets("VERITABANI").Range("c65536").End(3)(2, 1) = TextBox2
Sheets("VERITABANI").Range("d65536").End(3)(2, 1) = TextBox1
Sheets("VERITABANI").Range("e65536").End(3)(2, 1) = Cb2
Sheets("VERITABANI").Range("f65536").End(3)(2, 1) = Cb1
Sheets("VERITABANI").Range("g65536").End(3)(2, 1) = TextBox10
Sheets("VERITABANI").Range("h65536").End(3)(2, 1) = TextBox5000.Value
Sheets("VERITABANI").Range("I65536").End(3)(2, 1) = TextBox11
Sheets("VERITABANI").Range("J65536").End(3)(2, 1) = TextBox5001.Value
Sheets("VERITABANI").Range("K65536").End(3)(2, 1) = Cb107
Sheets("VERITABANI").Range("L65536").End(3)(2, 1) = TextBox107.Value
Sheets("VERITABANI").Range("M65536").End(3)(2, 1) = TextBox1007.Value
Sheets("VERITABANI").Range("N65536").End(3)(2, 1) = Cb108
Sheets("VERITABANI").Range("O65536").End(3)(2, 1) = TextBox108.Value
Sheets("VERITABANI").Range("P65536").End(3)(2, 1) = TextBox1008.Value
Sheets("VERITABANI").Range("Q65536").End(3)(2, 1) = Cb109
Sheets("VERITABANI").Range("R65536").End(3)(2, 1) = TextBox109.Value
Sheets("VERITABANI").Range("S65536").End(3)(2, 1) = TextBox1009.Value
Sheets("VERITABANI").Range("T65536").End(3)(2, 1) = Cb110
Sheets("VERITABANI").Range("U65536").End(3)(2, 1) = TextBox110.Value
Sheets("VERITABANI").Range("V65536").End(3)(2, 1) = TextBox1010.Value
Sheets("VERITABANI").Range("W65536").End(3)(2, 1) = Cb111
Sheets("VERITABANI").Range("X65536").End(3)(2, 1) = TextBox111.Value
Sheets("VERITABANI").Range("Y65536").End(3)(2, 1) = TextBox1011.Value
Sheets("VERITABANI").Range("Z65536").End(3)(2, 1) = Cb112
Sheets("VERITABANI").Range("AA65536").End(3)(2, 1) = TextBox112.Value
Sheets("VERITABANI").Range("AB65536").End(3)(2, 1) = TextBox1012.Value
Sheets("VERITABANI").Range("Ac65536").End(3)(2, 1) = Label525
Sheets("VERITABANI").Range("AD65536").End(3)(2, 1) = Label555
Sheets("VERITABANI").Range("AF65536").End(3)(2, 1) = TextBox5.Value

For I = 1 To Range("c65536").End(3).Row
On Error Resume Next

If (Range("c" & I).Value <> "") Then
Range("A" & I) = I
End If


Next I

For I = 1 To 5001
Controls("Textbox" & I).Value = ""
Next
For I = 101 To 112
Controls("Textbox" & I).Value = "0"
Next
For I = 1001 To 1012
Controls("Textbox" & I).Value = "0"
Next
'Cb2.Value = False
'Cb1.Value = False


'For i = 1 To 112
'Controls("ComboBox.Value" & i).Value = False

Cb1.Value = ""
Cb2.Value = ""
Cb101.Value = ""
Cb102.Value = ""
Cb103.Value = ""
Cb104.Value = ""
Cb105.Value = ""
Cb106.Value = ""
Cb107.Value = ""
Cb108.Value = ""
Cb109.Value = ""
Cb110.Value = ""
Cb111.Value = ""
Cb112.Value = ""
TBox2 = ""
TextBox10.Value = ""
TextBox11.Value = ""
MsgBox ("Bilgiler veri tabanına kaydedildi.")
End If
Next
End Sub

---------------------

 

[Korhan Ayhan]

Mükerrer kayıt kontrolü yapan For-Each-Next döngüsünde NEXT satırı görünmüyor.

Aşağıdaki gibi düzenlerseniz sorun çözülür gibi görünüyor.

Exit Sub
End If
Next

 

[excelicent]

Çok teşekkür ederim. Sorun çözüldü.

 

[excelicent]

Aşağıdaki kodlarla textbox2 ye göre arama yapıp mükerrer kayıt uyarısı yapıyordu. Hem textbox, hem de combobox verisine göre ilgili excel sütunlarında arasın, textboxdaki text mükerrer ise aynı veriye bağlı combobox da mükerrer mi kontrol etsin. Bu konu hakkında bilgilendirme yapabileceklerden yardım bekliyorum.

Dim bul As Range
Sheets("VERITABANI").Select
[A65536].End(xlUp).Offset(1, 0).Select
For Each bul In Range("c2:c" & Range("c65536").End(3).Row)
If bul.Value = TextBox2.Text Then

Else
If MsgBox("Aynı kayıt bulundu, yine de kaydedilsin mi?", vbYesNo, "Takip Programı") = vbNo Then
Exit Sub
End If

 

[excelicent]

Ne istediğim anlaşılsın diye; nasıl yaparım diye kafa yorduğum hali aşağıda.

Dim bul As Range
Dim bul2 As Range
Sheets("VERITABANI").Select
[A65536].End(xlUp).Offset(1, 0).Select
For Each bul In Range("c2:c" & Range("c65536").End(3).Row)
For Each bul2 In Range("e2:e" & Range("e65536").End(3).Row)
If bul.Value = TextBox2.Text & bul2.Value = Cb2.Text Then

Else
If MsgBox("Aynı kayıt bulundu, yine de kaydedilsin mi?", vbYesNo, "Takip Programı") = vbNo Then
Exit Sub

'Else
End If