Check if list of Emails Valid or not (VBA Regex)

If we have a list of email addresses, like about 20,000 and we want to check if they are valid i.e. (valid format with an email id followed by ‘@’ and then domain name) then this macro can help us in doing this with a click.

Example sheet also available at end for Download

We will use VBA and the regular expression function (Regex).

To use Regex we need to do a few things beforehand.

Add VBA reference to "Microsoft VBScript Regular Expressions 5.5"

Ø For this select the “Developer tab”. If you don’t have it then (for Office 2010) go to File -> Options ->Customize Ribbons ->Popular Commands in Choose commands from -> Click on Developer tab box in customize the ribbon box.

Ø Now you can see the Developer tab on top, click on it and then on Visual Basic.

Ø Go to Tools -> References and select Microsoft VBScript Regular Expressions 5.5.




Now you are set to run the Regex Macros.

Below is the VB Code of Macro.

Sub amiq()

Dim strPattern As String: strPattern = "^[\w-\.]{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,3}$"
Dim regEx As New RegExp
Dim strInput As String
Dim r As Integer

For r = 2 To Selection.Rows.Count
If strPattern <> "" Then
strInput = Cells(r, 1).Value
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With

If regEx.Test(strInput) Then

Cells(r, 2).Value = "Valid Email Address"
Else
Cells(r, 2).Value = "Not Valid"
End If
End If
Next r
End Sub


I have found this Regex pattern to check mail address validity from totorialspoint.

Please download the example Macro enabled workbook to see how it works. You just need to paste the list of mails in the first column then select and press the button. The second column will show their validity status.


Click Here to Download the Example File

Similarly if we want to identify the cases where text field have consecutive duplicate words and store the duplicate word in results, then we can use the below regex pattern.

Sub amiq()

Dim strPattern As String: strPattern = "\b(\w+)\b\s+\1\b"

Dim regEx As New RegExp

Dim strInput As String

Dim r As Integer

For r = 2 To Selection.Rows.Count

If strPattern <> "" Then

strInput = Cells(r, 6).Value

With regEx

.Global = True

.MultiLine = True

.IgnoreCase = False

.Pattern = strPattern

Set allMatches = regEx.Execute(strInput)

End With

If allMatches.Count <> 0 Then

Cells(r, 7).Value = allMatches.Item(0)

Else

Cells(r, 7).Value = "Valid"

End If

End If

Next r

End Sub