Excel VB | Validate Email Address

I generally validate email addresses in Filemaker and find this a much quick and easier solution. But I get asked a fair bit how would you be able to validate an email address in Excel.

There are a couple of ways to do this, a quick and simple approach is to simply check if the cell is a hyperlink (i.e. Excel has done a check as it was entered) and then check for “@”.

Sub IsValidEMailAddress_Simple()
Range(“A1″).Select
If ActiveCell.Hyperlinks(1).Type = msoHyperlinkRange Then
intChar = InStr(1, ActiveCell.Hyperlinks(1).Address, “@”)
MsgBox ActiveCell.Value & ” not hyperlink”
‘Was the ‘@’ found?
If intChar > 0 Then
‘Does hyperlink contain ‘@’?
MsgBox ActiveCell.Value & ” missing @”
End If
End If
End Sub

This generally isn’t ideal and so for a much more comprehensive check this code (an Excel VB function) will fully validate a referenced cell with an email address in as a true or false (boolean). There is a text file download at the end incase you get formatting issues with copy and paste.

Public Function IsValidEMailAddress( _
ByVal EMailAddress As String, _
Optional ByVal Strict As Boolean = False _
) As Boolean

‘ Return True if the email address referenced is valid, False otherwise.

Const Domain_Extensions = “|aero|biz|com|coop|edu|gov|info|int|mil|museum|name|net|org|pro|travel|”
Const Country_Extensions = “|ac|ad|ae|af|ag|ai|al|am|an|ao|aq|ar|as|at|au|aw|ax|az|ba|bb|bd|be|bf|bg|bh|bi|bj|bm|bn|bo|br|bs|

bt|bv|bw|by|bz|ca|cc|cd|cf|cg|ch|ci|ck|cl|cm|cn|co|cr|cs|cu|cv|cx|cy|cz|de|dj|dk|dm|do|dz|ec|ee|

eg|eh|er|es|et|eu|fi|fj|fk|fm|fo|fr|ga|gb|gd|ge|gf|gg|gh|gi|gl|gm|gn|gp|gq|gr|gs|gt|gu|gw|gy|hk|

hm|hn|hr|ht|hu|id|ie|il|im|in|io|iq|ir|is|it|je|jm|jo|jp|ke|kg|kh|ki|km|kn|kp|kr|kw|ky|kz|la|lb|lc|li|

lk|lr|ls|lt|lu|lv|ly|ma|mc|md|mg|mh|mk|ml|mm|mn|mo|mp|mq|mr|ms|mt|mu|mv|mw|mx|my|mz|

na|nc|ne|nf|ng|ni|nl|no|np|nr|nu|nz|om|pa|pe|pf|pg|ph|pk|pl|pm|pn|pr|ps|pt|pw|py|qa|re|ro|ru|rw|

sa|sb|sc|sd|se|sg|sh|si|sj|sk|sl|sm|sn|so|sr|st|sv|sy|sz|tc|td|tf|tg|th|tj|tk|tl|tm|tn|to|tp|tr|tt|tv|tw|

tz|ua|ug|uk|um|us|uy|uz|va|vc|ve|vg|vi|vn|vu|wf|ws|ye|yt|yu|za|zm|zw|”
Const Invalid_Chars = “/’\””;:?!()[]{}^| ”
Const Invalid_Chars_Strict = “/’\””;:?!()[]{}^|$&*+=`<>,% ”
Const Invalid_Domains = “|aso|dnso|icann|internic|pso|afrinic|apnic|arin|example|gtld-servers|iab|iana|iana-servers|iesg|ietf|irtf|istf|lacnic|latnic|rfc -editor|ripe|root-servers|nic|whois|www|arpa|”

Dim Index As Long
Dim Extension As String
Dim Domain As String
Dim Position1 As Long
Dim Position2 As Long

If Len(EMailAddress) = 0 Then
IsValidEMailAddress = True
Exit Function
End If

EMailAddress = LCase(EMailAddress)

‘ Check for invalid characters
If Strict Then
For Index = 1 To Len(EMailAddress)
If InStr(Invalid_Chars_Strict, Mid(EMailAddress, Index, 1)) > 0 Then
Exit Function
End If
Next Index
Else
For Index = 1 To Len(EMailAddress)
If InStr(Invalid_Chars, Mid(EMailAddress, Index, 1)) > 0 Then
Exit Function
End If
Next Index
End If

‘ Check for valid extension
Index = InStrRev(EMailAddress, “.”)
If Index = 0 Then Exit Function
Extension = Mid(EMailAddress, Index + 1)
If InStr(Domain_Extensions, “|” & Extension & “|”) = 0 And InStr(Country_Extensions, “|” & Extension & “|”) = 0 Then Exit Function

‘ Check for consecutive dots
If InStr(EMailAddress, “..”) > 0 Then Exit Function

‘ Check for more than one ampersand
If InStr(Replace(EMailAddress, “@”, ” “, Count:=1), “@”) > 0 Then Exit Function

‘ Check for text prior to the ampersand
Index = InStr(EMailAddress, “@”)
If Not Index > 1 Then Exit Function

‘ Check for a period after the ampersand
If Mid(EMailAddress, Index + 1, 1) = “.” Then Exit Function

Position1 = InStr(EMailAddress, “@”) + 1
Position2 = InStr(Position1, EMailAddress, “.”) – 1
Domain = Mid(EMailAddress, Position1, Position2 – Position1 + 1)

If Strict Then
‘ Check for single character domain
If Len(Domain) = 1 Then Exit Function
‘ Check for an invalid domain
If InStr(Invalid_Domains, “|” & Domain & “|”) > 0 Then Exit Function
If InStr(Domain_Extensions, “|” & Domain & “|”) > 0 Then Exit Function
End If

‘ Check for dash in the first, last, third, or fourth position of the domain
If Left(Domain, 1) = “-” Then Exit Function
If Right(Domain, 1) = “-” Then Exit Function
If Len(Domain) > 2 Then
If Mid(Domain, 3, 1) = “-” Then Exit Function
If Len(Domain) > 3 Then
If Mid(Domain, 4, 1) = “-” Then Exit Function
End If
End If

‘ Check for more then 67 characters in the domain and extension
If Len(Domain) + Len(Extension) > 67 Then Exit Function

IsValidEMailAddress = True

End Function

Download as a text file