Validating Email Address Entry in Spreadsheet Data Base

[wcm69]

Hi out there in Excel World <v:shapetype id="_x0000_t75" stroked="f" filled="f" path="m@4@5l@4@11@9@11@9@5xe" oreferrelative="t" o:spt="75" coordsize="21600,21600"> <v:stroke joinstyle="miter"> <v:formulas> <v:f eqn="if lineDrawn pixelLineWidth 0"> <v:f eqn="sum @0 1 0"> <v:f eqn="sum 0 0 @1"> <v:f eqn="prod @2 1 2"> <v:f eqn="prod @3 21600 pixelWidth"> <v:f eqn="prod @3 21600 pixelHeight"> <v:f eqn="sum @0 0 1"> <v:f eqn="prod @6 1 2"> <v:f eqn="prod @7 21600 pixelWidth"> <v:f eqn="sum @8 21600 0"> <v:f eqn="prod @7 21600 pixelHeight"> <v:f eqn="sum @10 21600 0"> </v:f></v:f></v:f></v:f></v:f></v:f></v:f></v:f></v:f></v:f></v:f></v:f></v:formulas> <vath o:connecttype="rect" gradientshapeok="t" o:extrusionok="f"> <o:lock aspectratio="t" v:ext="edit"></o:lock></vath></v:stroke></v:shapetype><v:shape id="Picture_x0020_3" style="width: 11.25pt; height: 11.25pt; visibility: visible; mso-wrap-style: square;" type="#_x0000_t75" alt="https://www.mrexcel.com/forum/images/smilies/icon_smile.gif" o:spid="_x0000_i1027"> <v:imagedata o:title="icon_smile" src="file:///C:\Users\Wayne\AppData\Local\Temp\msohtmlclip1\01\clip_image001.gif"></v:imagedata></v:shape>

Can anyone advise where I'm going wrong with a particular formula. <v:shape id="Picture_x0020_2" style="width: 18.75pt; height: 15pt; visibility: visible; mso-wrap-style: square;" type="#_x0000_t75" alt="https://www.mrexcel.com/forum/images/smilies/icon_banghead.gif" o:spid="_x0000_i1026"> <v:imagedata o:title="icon_banghead" src="file:///C:\Users\Wayne\AppData\Local\Temp\msohtmlclip1\01\clip_image002.gif"></v:imagedata></v:shape>

I have created a spread sheet (table) data base that the end user will fill in.

I have a cell for users to enter (their) email addresses and I want to ensurewhen an email address is typed into the cell, that it isin the correct form, i.e. no spaces, an @ and period (.). If not then I want an error message to alert the user.

I want a formula for thorough email validation. For example ifthe end user types this: @@.com, an error shouldbe flagged.

I'm currently trying the following formula's (entered in the Data ValidationBox):

=AND(FIND("@",I2),FIND(".",I2),ISERROR(FIND("",I2)))

=ISNUMBER(MATCH("*@*.???",I2,0))

But both return error messages on the (test) email addressesI've tried (correct and incorrect). Can somebody please,please tell where I'm going wrong on either of the formulas.

Or even better - post a formula to achieve my aim. I'm trying not touse VBA as I'm not experienced in it.

My gratitude in advance :wink:<v:shape id="Picture_x0020_1" style="width: 11.25pt; height: 11.25pt; visibility: visible; mso-wrap-style: square;" type="#_x0000_t75" alt="https://www.mrexcel.com/forum/images/smilies/icon_wink.gif" o:spid="_x0000_i1025"> <v:imagedata o:title="icon_wink" src="file:///C:\Users\Wayne\AppData\Local\Temp\msohtmlclip1\01\clip_image003.gif"></v:imagedata></v:shape><o></o>

 

[Logit]

Paste in routine module:

Option Explicit


Sub email()
    Dim txtEmail As String
    txtEmail = Sheets("Sheet1").Range("A1").Value   '<-- Use cell A1 for entering email address. Change as needed
     
    Dim Situacao As String
     
     ' Check e-mail syntax
    If IsEmailValid(txtEmail) Then
        Situacao = "Valid e-mail syntax!"
    Else
        Situacao = "Invalid e-mail syntax!"
    End If
     ' Shows the result
    MsgBox Situacao
End Sub


Function IsEmailValid(strEmail)
    Dim strArray As Variant
    Dim strItem As Variant
    Dim i As Long, c As String, blnIsItValid As Boolean
    blnIsItValid = True
     
    i = Len(strEmail) - Len(Application.Substitute(strEmail, "@", ""))
    If i <> 1 Then IsEmailValid = False: Exit Function
    ReDim strArray(1 To 2)
    strArray(1) = Left(strEmail, InStr(1, strEmail, "@", 1) - 1)
    strArray(2) = Application.Substitute(Right(strEmail, Len(strEmail) - Len(strArray(1))), "@", "")
    For Each strItem In strArray
        If Len(strItem) <= 0 Then
            blnIsItValid = False
            IsEmailValid = blnIsItValid
            Exit Function
        End If
        For i = 1 To Len(strItem)
            c = LCase(Mid(strItem, i, 1))
            If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
                blnIsItValid = False
                IsEmailValid = blnIsItValid
                Exit Function
            End If
        Next i
        If Left(strItem, 1) = "." Or Right(strItem, 1) = "." Then
            blnIsItValid = False
            IsEmailValid = blnIsItValid
            Exit Function
        End If
    Next strItem
    If InStr(strArray(2), ".") <= 0 Then
        blnIsItValid = False
        IsEmailValid = blnIsItValid
        Exit Function
    End If
    i = Len(strArray(2)) - InStrRev(strArray(2), ".")
    If i <> 2 And i <> 3 Then
        blnIsItValid = False
        IsEmailValid = blnIsItValid
        Exit Function
    End If
    If InStr(strEmail, "..") > 0 Then
        blnIsItValid = False
        IsEmailValid = blnIsItValid
        Exit Function
    End If
    IsEmailValid = blnIsItValid
End Function

 

[wcm69]

Hi Logit

Thank you for your help on this problem.

I finally managed to get the code to work in my spreadsheet (I did say I'm not really VBA smart ).

I'm hoping you might be able to assist me a little further (for this code to completely fit my needs)? Are you able to tell me the code (and on which line to put it) for making the cell (J2) clear if an incorrect email address is put in? Also (if it's not asking too much) can you also tell me how to then make the cursor go to the next cell (to the right) rather than down after the user presses ok to accept the email is correct?

Any help or advise is appreciated, but if you're not able to, I'm grateful for your help so.

 

[Logit]

If I understand correctly, you are using cell J2 for the email entry rather A1 ?

If this is accurate (changes in RED) :

Option Explicit


Sub email()
Dim txtEmail As String
txtEmail = Sheets("Sheet1").Range("J2").Value '<-- Use cell A1 for entering email address. Change as needed

Dim Situacao As String

' Check e-mail syntax
If IsEmailValid(txtEmail) Then
Situacao = "Valid e-mail syntax!"
Else
Situacao = "Invalid e-mail syntax!"
Sheets("Sheet1").Range("J2").Value = ""
End If
' Shows the result
MsgBox Situacao
Range("K2").Select
End Sub

 

[wcm69]

Many thanks for your response.

I've tried the amendments (in red) but when I run the code it now doesn't give the option box to "retype or cancel" the input. It also doesn't clear the email entry cell ("J2") where the incorrect email address is written. It has also had a couple of run time errors.

Any ideas where I might be going wrong.

Note: your last range says: Range("K2").Select - I've changed that to ("J2") and tried both just in case.

Much appreciated.

 

[Logit]

I believe you have more code in your project than has been made known. Without seeing all of the code
it is difficult to determine where the error might be.

If you can post your workbook to a 'cloud site' for download, that would be the best option for troubleshooting.

DropBox, Amazon Cloud, Google, etc.

Thanks

 

[wcm69]

The code only I'm using is the one supplied at the start of the thread with the Range changed to the appropriate input cell ("J2"). What would work for my purposes is for a correct (email address) entry into (cell "J2") to OFFSET straight to the next empty column (cell "K2"), without the need for the situacao msg verifying it.

The situacao msg "Invalid e-mail syntax!" is only needed to warn of an incorrect email address and the input cell ("J2") to clear to allow a correct address to be re-entered.

If you think you got a solution I'd be grateful. As I said I'm self teaching on VBA so do a lot of trial and error.
You're help is appreciated.

 

[Logit]

The code in Post #2 works here without error.

???