Is this Macro possible?

R

rodriar

New Member
Joined
May 4, 2015
Messages
14
Hi,

I would like to create a macro or excel formula that can verify email addresses in a column.

For example, I need to verify a list with a lot of emails that cannot have any special characters or spaces, just one below each other like these:

john.doe@extension.com
john.doe@extension.com
john.doe@extension.com
john.doe@extension.com
john.doe@extension.com
john.doe@extension.com

And if someone comes up with a list that contains special characters or spaces, the formula/macro could verify and highlight where is the error. I just want to paste the whole list in a column to get it validated.

john.doe@extension.com
john.doe@extension.com
john./doe@extension.com
john.doe@extension.com
john.doe@extension.com
john.doe@extension.com

Let me know if i was clear :)

Thanks,
 
Sort by date Sort by votes

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Rick Rothstein said:
Are you sure you want to automatically assume that a bad character should be removed as opposed to assuming it was a mistype of a dot (I am thinking particularly of the slash as it is right next to the dot, but the same could apply to a semicolon, apostrophe or comma as well)? Your original post asked to have them identified which made more sense to me as you could (theoretically) look at the email address and decide on a case-by-case basis whether the character should be removed or corrected to a dot. If you want automatic correction, I rewrite the code for you, just let me know, but be aware that such code will be much slower than the code I posted earlier.

Also, I am pretty sure you do not want to remove the @ symbol given the code is parsing email addresses. There is a question of what to do if there are two ampersands in the same address... you cannot expect the code to be able to decide which one should be removed. Also, if there is no dot after the ampersand, that email address would be improper... again, you cannot expect the code to figure out how to include one. For these two cases, I am guessing highlighting them in red is still okay to do even if your answer to my question above is to remove those "bad" symbols.
Click to expand...

Hi Rick,

Sorry, i didn't see the notification on this message:

I agree that it would be better to get it highlighted than removed automatically. But what I would like the macro to do is to automatically remove the blank spaces if there is any, this is not necessary to be checked manually as there are all email addresses and a 'blank' is not allowed. The other extra characters can be highlighted as you did :) that would be great

This can be:

john.doe/@example.com ----> highlighted
john.doe@ example.com ----> if it's a space, removed.
john.-doe@example.com ----> highlighted
john."doe@example.com ----> highlighted
john.2doe@example.com ----> highlighted
john.$doe@example.com ----> highlighted
john.#doe@example.com ----> highlighted
john.doe@example.com
john.doe@example.com
 
Upvote 0
rodriar said:
This can be:

john.doe/@example.com ----> highlighted
john.doe@ example.com ----> if it's a space, removed.
john.-doe@example.com ----> highlighted
john."doe@example.com ----> highlighted
john.2doe@example.com ----> highlighted
john.$doe@example.com ----> highlighted
john.#doe@example.com ----> highlighted
john.doe@example.com
john.doe@example.com
Click to expand...
Give this macro a try...
Code: 
Sub VerifyEmailAddresses()
  Dim R As Long, X As Long, CellVal As String
  Application.ScreenUpdating = False
  Columns("C").Replace " ", "", xlPart
  For R = 2 To Cells(Rows.Count, "C").End(xlUp).Row
    CellVal = Cells(R, "C").Value
    For X = 1 To Len(CellVal)
      If Mid(CellVal, X, 1) Like "[!A-Za-z.@]" Or _
         (Mid(CellVal, X, 1) = "@" And Len(CellVal) - _
         Len(Replace(CellVal, "@", "")) > 1) Then
        With Cells(R, "C").Characters(X, 1)
          .Font.ColorIndex = 3
          .Font.Bold = True
        End With
      ElseIf Mid(CellVal, X, 2) = ".." Then
        With Cells(R, "C").Characters(X, 2)
          .Font.ColorIndex = 3
          .Font.Bold = True
        End With
      End If
    Next
  Next
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
rodriar,

Thanks for the new character list.

Here is another macro for you to consider.

Sample raw data:


Excel 2007
C
1
2a'a
3b;b
4c_c
5d...d
6e..e
7f-f
8g/g
9h(h
10i%i
11j&j
12k#k
13m$m
14n"n
15n"n"
16n"n"n
17n"n"n"
18"n"n"n"
19o!o
20p p
21
Sheet1


After the new macro:


Excel 2007
C
1
2aa
3bb
4cc
5dd
6ee
7ff
8gg
9hh
10ii
11jj
12kk
13mm
14nn
15nn
16nnn
17nnn
18nnn
19oo
20pp
21
Sheet1


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code: 
Sub RemoveSpecialCharactersV2()
' hiker95, 05/05/2015, ME852996
With Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",CHAR(34),""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""/"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ","" "",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""'"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ","";"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""_"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""..."",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ","".."",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""-"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""("",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""%"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""&"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""#"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""$"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""!"",""""),"""")")
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the RemoveSpecialCharactersV2 macro.
 
Upvote 0
hiker95 said:
rodriar,

Thanks for the new character list.

Here is another macro for you to consider.
Code: 
Sub RemoveSpecialCharactersV2()
' hiker95, 05/05/2015, ME852996
With Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",CHAR(34),""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""/"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ","" "",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""'"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ","";"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""_"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""..."",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ","".."",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""-"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""("",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""%"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""&"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""#"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""$"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""!"",""""),"""")")
End With
End Sub
Click to expand...
I know the special characters list the OP posted does not show it, but if you look at the OP's reply to me (Message #13), you will see he also does not want to leave digits in the text as well (personally, I think that is a mistake because I have seen names with numbers in email addresses before). The digits issue is not all that important in my macro because my macro simply highlights the supposedly bad characters, so the OP could choose to ignore the digit if he recognizes it belongs there, but the treatment of digits in your macro is more critical given you remove the character completely which means the OP would never know a digit had been in the email address. Also, I took the three dots to be an ellipsis (ASCII code 133) and not three individual dots.
 
Last edited:
Upvote 0
hiker95 said:
rodriar,

Thanks for the new character list.

Here is another macro for you to consider.

Sample raw data:

Excel 2007
C
1
2a'a
3b;b
4c_c
5d...d
6e..e
7f-f
8g/g
9h(h
10i%i
11j&j
12k#k
13m$m
14n"n
15n"n"
16n"n"n
17n"n"n"
18"n"n"n"
19o!o
20p p
21

<colgroup><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1​



After the new macro:

Excel 2007
C
1
2aa
3bb
4cc
5dd
6ee
7ff
8gg
9hh
10ii
11jj
12kk
13mm
14nn
15nn
16nnn
17nnn
18nnn
19oo
20pp
21

<colgroup><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1​



Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code: 
Sub RemoveSpecialCharactersV2()
' hiker95, 05/05/2015, ME852996
With Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",CHAR(34),""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""/"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ","" "",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""'"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ","";"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""_"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""..."",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ","".."",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""-"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""("",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""%"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""&"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""#"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""$"",""""),"""")")
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""!"",""""),"""")")
End With
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the RemoveSpecialCharactersV2 macro.
Click to expand...


Thank you! you're great!
 
Upvote 0
You're a genius! I dont have a good relationship with Excel, and for me, what you've done is amazing. Thank you very much!!!!!!!!!
 
Upvote 0
rodriar said:
I dont have a good relationship with Excel, and for me, what you've done is amazing. Thank you very much!!!!!!!!!
Click to expand...
Just out of curiosity, who are you thanking (you did not reply with quote, so there is no reference for your post)?
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA Macro - How to send a single email to recipients showing one or more times in an excel table
Replies
0
Views
841
AndreMateus
A
J
  • Question
Excel VBA Help
2
Replies
15
Views
399
Rick Rothstein
Rick Rothstein
B
  • Question
When is a number not a number? Match() does not recognize number.
Replies
7
Views
524
Tupe77
T
B
  • Question
VBA macro for removing entire alphabet some special characters
Replies
1
Views
255
BobMaccaroni
B
S
  • Question
What could be refreshing my ODBC connections in this code?
Replies
0
Views
462
sspatriots
S

Forum statistics

Threads
1,215,029
Messages
6,122,757
Members
449,094
Latest member
dsharae57

Share this page

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
Back
Top