منع تكرار الصنف

[mohamedyousef]

السلام عليكم 

الاخوة الافاضل الملف المرفق محتاج اضيف كود يمنع تكرار الصنف المسجل حيث اثناء عمل الاصافة يتم تسجيل صنف وهو مسجل بالفعل من قبل محتاج رسالة تنبيه عند اضافة صنف مسجل مسبقا بان هذا الصنف تم تسجيله من قبل ولحضراتكم جزيل الشكر 

 

منع تكرار.xlsm

تم تعديل منذ 17 ساعات بواسطه mohamedyousef
ارسال الملف مرة اخري

[أبوعيد]

إذا تطابق اللون والوصف والمقاس سيتم ألغاء الإضافة

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim WS As Worksheet, rng As Range
Dim lastRow As Long
Set WS = Sheet1
If Me.TextBox4 = "" Then: Exit Sub
'=======
lastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow ' äÈÏà ãä ÇáÕÝ 2 assuming ÇáÕÝ ÇáÃæá ÚäÇæíä
        If WS.Cells(i, 2).Value = Me.TextBox1.Value _
        And WS.Cells(i, 3).Value = Me.TextBox7.Value _
        And WS.Cells(i, 4).Value = Me.TextBox2.Value _
         Then
            MsgBox "ÇáÈíÇäÇÊ ÇáÊí ÊÍÇæá ÃÖÇÝÊåÇ ãæÌæÏÉ ãä ÞÈá", vbOKOnly, "ÈíÇäÇÊ ãßÑÑÉ"
            Exit Sub
        End If
    Next i
'=======
Set rng = WS.Range("a2100").End(xlUp).Offset(1, 0)
rng.Offset(0, 0).Value = Me.TextBox4.Value
rng.Offset(0, 1).Value = Me.TextBox1.Value
rng.Offset(0, 3).Value = Me.TextBox2.Value
rng.Offset(0, 5).Value = Me.TextBox3.Value
rng.Offset(0, 6).Value = Me.TextBox5.Value
rng.Offset(0, 7).Value = Me.TextBox6.Value
rng.Offset(0, 2).Value = Me.TextBox7.Value
For i = 1 To 7
Controls("textbox" & i).Text = Empty
    Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[mohamedyousef]

الشلام عليكم

شكرا اخي الفاضل على المساعدة تمام كما طلبت الف شكر