VBA - If Cell Contains Email address

karan2211

New Member
Joined
Aug 7, 2014
Messages
4
Hi There,

I want to get a VBA code for checking if a particular cells has got any email address

Suppose Cell A1 = abc then it should give error "Please enter a valid email address"

and If Cell A1 = abc@xyz then it should let the user enter that value as it is a valid email address

VBA code can look for @ in the cell value if @ sign is not present a msgbox will appear.

Any help will be much appreciated.

Thanks!
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Chris Mack

Well-known Member
Joined
Jun 18, 2013
Messages
803
Do you want this MsgBox to appear when you've made an attempt at typing the email address in? Or is it a button click to check the whole column? Etc.
 

karan2211

New Member
Joined
Aug 7, 2014
Messages
4
Do you want this MsgBox to appear when you've made an attempt at typing the email address in? Or is it a button click to check the whole column? Etc.

Hi Chris,

Thanks for your reply.

I want the msgbox to appear after the attempt has been made.
 

Chris Mack

Well-known Member
Joined
Jun 18, 2013
Messages
803
Hi

This is what I've got so far, assuming you'll be putting the email address in column B (i.e. column 2, as per the code), put this code in the 'ThisWorkbook' object:

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Column = 2 And Target.Value <> "" And Evaluate("COUNTIF(" & Target.Address & ",""*@*.*"")") <> 1 Then
        Target.ClearContents
        Target.Activate
        MsgBox "Please enter a valid email address."
    End If
End Sub
I've put another qualifier in for a full stop (period) (I'm not sure it's a requirement of an email address but I'm pretty sure it is, anyway you can see from the code I'm testing for the format "*@*.*", where * is a wildcard).

Let me know if this is appropriate.

Hope this helps,

Chris.
 

karan2211

New Member
Joined
Aug 7, 2014
Messages
4
Hi Chris,

The email address needs to be entered in a merged cell E7:H7 and I tried changing the Target.Column = 5 as per E Column and pasted the Macro in This Workbook but it was not working. Am I doing something wrong?

Thanks in advance for helping me. :)
 

Chris Mack

Well-known Member
Joined
Jun 18, 2013
Messages
803
This should work:

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    cell = Left(Range(Target, Target.Offset(0, 2)).Address, InStr(Range(Target, Target.Offset(0, 2)).Address, ":") - 1)
    If Range(cell).Column = 5 And Range(cell).Value <> "" And Evaluate("COUNTIF(" & Range(cell).Address & ",""*@*.*"")") <> 1 Then
        Range(Target, Target.Offset(0, 3)).ClearContents
        Target.Activate
        MsgBox "Please enter a valid email address."
    End If
End Sub
Hope this helps,

Chris.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,119
Messages
5,640,218
Members
417,131
Latest member
Seanr19871

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top