[VBA] Έλεγχος διπλοεγγραφής βάση του ΑΜΚΑ

[gfevran]

Καλημέρα κ καλό μήνα,
Φτιάχνω μια μικρή εφαρμογή και θέλω ελέγχω διπλό εγγραφών με βάση το ΑΜΚΑ.
Σε αυτό το σημείο θα ήθελα τη βοήθεια σας,

Ευχαριστώ για όποια βοήθεια.

[Tasos]

Καλησπέρα σε σε όλους!

Γιώργο δοκίμασε τον παρακάτω κώδικα στη φόρμα::

Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim fCell As Range
    TextBox3.Value = Trim(TextBox3.Value)
    If TextBox3.Value = "" Then Exit Sub
    Set fCell = Worksheets("Data").Range("c:c").Find(What:=TextBox3.Value, LookIn:=xlValues, Lookat:=xlWhole)
    If Not fCell Is Nothing Then
        Cancel = True
        TextBox3.Value = ""
        TextBox3.SetFocus
        MsgBox "Διπλοεγγραφή!.....", vbExclamation, "Προσοχή"
    End If
End Sub

Καλή συνέχεια!

Τάσος

[gfevran]

Τάσο καλησπέρα,
Ευχαριστώ για την άμεση απάντηση,
προσάρμοσα την πρόταση σου και έχω το εξής πρόβλημα,
όταν ανεβάσω από τη Listbox μια εγγραφή που ήδη έχει ΑΜΚΑ
και κάνω αποθήκευση τότε αποθηκεύεται.
όταν προσθέσω νέα εγγραφή με υπάρχον ΑΜΚΑ τότε λειτουργεί καλά, βγάζει μήνυμα,
και δεν κάνει καταχώρηση.

Ευχαριστώ και πάλι
Με εκτίμηση Γιώργος

[Tasos]

Γιώργο μου το συμβάν "TextBox3_BeforeUpdate" θα τρέξει μόνο αν προκληθεί από τον χρήστη.

Δεν τρέχει όταν αλλάξει η τιμή του πεδίου προγραμματιστικά.

Προτείνω να χρησιμοποιήσεις την παρακάτω συνάρτηση:

Private Function ValueExists(strValue As String) As Boolean
    If strValue = "" Then Exit Function
    Set fCell = Worksheets("Data").Range("c:c").Find(What:=TextBox3.Value, LookIn:=xlValues, Lookat:=xlWhole)
    ValueExists = Not fCell Is Nothing
End Function

Η συνάρτηση ελέγχει αν υπάρχει διπλότυπο στη στήλη C και μπορεί να κληθεί από οποιοδήποτε σημείο της φόρμας ως εξής:

Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    If ValueExists(Trim(TextBox3.Value)) Then
        Cancel = True
        '........
    End If
End Sub

ή

Private Sub ListBox1_Click()
    Dim say As Long, a As Byte

    If ValueExists(ListBox1.Column(2)) Then
        ' Υπάρχει διπλοεγγραφή. Κάνε κάτι.
        ' πχ. Exit Sub ή Msgbox
    End If

    '.............
    '.............

End Sub

Καλή συνέχεια!

Με εκτίμηση

Τάσος

[gfevran]

Τάσο,
Δούλεψε μια χαρά!

Ευχαριστώ πολλή.