Excel vba

[cova1]

Hallo wie kan helpen?
Het lukt mij niet om via userform mijn lijst in te vullen blijft altijd op dezelfde rij staan (rij A lukt wel andere rijen niet)
RRN zou enkel mogen xx.xx.xx-xxx.xx(enkel cijfers)zoniet msg box (voldoet niet aan )
Geboortedatum ook xx.xx.xxxx (anders ook msg box )
Telefoon ook xxxx/xx xx xx (anders ook msg box)
Email moet @ bevatten (anders msg box =geen geldig mail

Ik ben leek in vba , en zoek alles via web of youtube, maar voor deze vindt ik geen oplossing.
Excel 2019 versie

 

[edmoor]

Probeer dit eens voor de knop Opslaan:

Private Sub CommandButton1_Click()
    With Sheets("Leden")
        lr = Range("A1").End(xlDown).Row + 1
        .Cells(lr, 1) = lr - 2
        .Cells(lr, 2) = TextBox1.Text
        .Cells(lr, 3) = TextBox2.Text
        .Cells(lr, 4) = TextBox3.Text
        .Cells(lr, 5) = TextBox4.Text
        .Cells(lr, 6) = TextBox5.Text
        .Cells(lr, 7) = TextBox6.Text
        .Cells(lr, 8) = TextBox7.Text
        .Cells(lr, 9) = ComboBox1.Text
        .Cells(lr, 10) = TextBox8.Text
    End With
End Sub

 

[HSV]

Array = 1 x wegschrijven.

 

[cova1]

Probeer dit eens voor de knop Opslaan:

Private Sub CommandButton1_Click()
    With Sheets("Leden")
        lr = Range("A1").End(xlDown).Row + 1
        .Cells(lr, 1) = lr - 2
        .Cells(lr, 2) = TextBox1.Text
        .Cells(lr, 3) = TextBox2.Text
        .Cells(lr, 4) = TextBox3.Text
        .Cells(lr, 5) = TextBox4.Text
        .Cells(lr, 6) = TextBox5.Text
        .Cells(lr, 7) = TextBox6.Text
        .Cells(lr, 8) = TextBox7.Text
        .Cells(lr, 9) = ComboBox1.Text
        .Cells(lr, 10) = TextBox8.Text
    End With
End Sub

Deze doet het , reeds dank
Voor andere ook een oplossing?

 

[JEC.]

Waar Harry op doelt

Private Sub CommandButton1_Click()
 With Sheets("Leden").Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
   .Resize(, 10) = Array(.Row - 2, TextBox1, TextBox2, TextBox3, TextBox4, TextBox5, TextBox6, TextBox7, ComboBox1, TextBox8)
 End With
End Sub

 

[cova1]

Waar Harry op doelt

Private Sub CommandButton1_Click()
 With Sheets("Leden").Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
   .Resize(, 10) = Array(.Row - 2, TextBox1, TextBox2, TextBox3, TextBox4, TextBox5, TextBox6, TextBox7, ComboBox1, TextBox8)
 End With
End Sub

Werkt ook voortreffelijk,
idee voor andere
RRN zou enkel mogen xx.xx.xx-xxx.xx(enkel cijfers)zoniet msg box (voldoet niet aan )
Geboortedatum ook xx.xx.xxxx (anders ook msg box )
Telefoon ook xxxx/xx xx xx (anders ook msg box)
Email moet @ bevatten (anders msg box =geen geldig mail

grt

 

[sylvester-ponte]

je schrijft :

"RRN zou enkel mogen xx.xx.xx-xxx.xx(enkel cijfers)zoniet msg box (voldoet niet aan )

moeten de puntjes en het streepje ook getypt worden of mogen ze ook weg gelaten worden?

 

[cova1]

je schrijft :
moeten de puntjes en het streepje ook getypt worden of mogen ze ook weg gelaten worden?

Graag puntjes en ook streepje erbij ( indien mogelijk natuurlijk)
Groeten

 

[edmoor]

Voor je email adres controle:

Private Sub TextBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Not EmailCheck(TextBox8.Text) Then
        MsgBox "Incorrect email adres", vbCritical, "Email"
        Cancel = True
    End If
End Sub

Function EmailCheck(sEmail As String) As Boolean
    Dim sEmailPattern As String
    Dim oRegEx As Object
    
    sEmailPattern = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"
    
    Set oRegEx = CreateObject("VBScript.RegExp")
    oRegEx.Global = True
    oRegEx.IgnoreCase = True
    oRegEx.Pattern = sEmailPattern
    
    If oRegEx.Test(sEmail) Then EmailCheck = True
End Function

 

[JEC.]

Misschien is dit ook wel voldoende voor je Email controle

if InStr(TextBox8.Text, "@") then ....

 

[edmoor]

Wat ik er bij mijn controle nog leuk bij vind is dit als extra:

Private Sub TextBox8_Change()
    wit = &H80000005
    oranje = &H80C0FF
    TextBox8.BackColor = IIf(EmailCheck(TextBox8.Text), wit, oranje)
End Sub

 

[cova1]

Voor je email adres controle:

Private Sub TextBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Not EmailCheck(TextBox8.Text) Then
        MsgBox "Incorrect email adres", vbCritical, "Email"
        Cancel = True
    End If
End Sub

Function EmailCheck(sEmail As String) As Boolean
    Dim sEmailPattern As String
    Dim oRegEx As Object
    
    sEmailPattern = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"
    
    Set oRegEx = CreateObject("VBScript.RegExp")
    oRegEx.Global = True
    oRegEx.IgnoreCase = True
    oRegEx.Pattern = sEmailPattern
    
    If oRegEx.Test(sEmail) Then EmailCheck = True
End Function

Deze doet het prima

 

[cova1]

Misschien is dit ook wel voldoende voor je Email controle

if InStr(TextBox8.Text, "@") then ....

Nee deze lukt niet , mischien doe ik iets verkeerd?

 

[cova1]

Wat ik er bij mijn controle nog leuk bij vind is dit als extra:

Private Sub TextBox8_Change()
    wit = &H80000005
    oranje = &H80C0FF
    TextBox8.BackColor = IIf(EmailCheck(TextBox8.Text), wit, oranje)
End Sub

Komt deze extra bij uw vorige?

 

[edmoor]

Ja, dat is een extra Sub.

 

[JEC.]

Nee deze lukt niet , mischien doe ik iets verkeerd?

Ben benieuwd. Hoe heb je de code gebruikt

 

[edmoor]

Dan wordt wel iedere tekst met een @ er in als geldig email adres geaccepteerd.

 

[JEC.]

Klopt, maar dit is een textbox waar specifiek een email adres wordt gevraagd.

Private Sub TextBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 If Len(TextBox8) Then If Not TextBox8.Text Like "*@*.*" Then MsgBox "correct adres invullen": Cancel = True
End Sub

 

[cova1]

Klopt, maar dit is een textbox waar specifiek een email adres wordt gevraagd.

Private Sub TextBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 If Len(TextBox8) Then If Not TextBox8.Text Like "*@*.*" Then MsgBox "correct adres invullen": Cancel = True
End Sub

Oke deze doet het ook.

 

[cova1]

Email is perfect , met dank aan Edmoor en Jec
Nu nog enkel
RRN zou enkel mogen xx.xx.xx-xxx.xx(enkel cijfers)zoniet msg box (voldoet niet aan )
Geboortedatum ook xx.xx.xxxx (anders ook msg box )
Telefoon ook xxxx/xx xx xx (anders ook msg box)
iemand