VBA To Extract Email Address From Text

[dunndealpr]

Hey there. I have many Excel files which each have four columns of data (A, B, C, and D) and tens of thousands of rows. I need any email addresses present in column D extracted to column E. What's the best solution here? The text surrounding the emails is always different (ie the emails are not surrounded by <> or any other kind of constant characters that can simplify this).

I've tried DigDB but it seems to have a run-time error 6 and/or 1004 issue no matter what I do. DigDB also misses more than a few emails that I can see in plan view. I've tried a couple other programs but they save the emails in a separate document, and I need the emails saved in the original file alongside the data it was extracted from, so that's no help to me.

Any ideas? Thanks in advance.

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3 (https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
ttps://www.youtube.com/watch?v=LP9fz2DCMBE (ttps://www.youtube.com/watch?v=LP9fz2DCMBE)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8 (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8)
ttps://www.youtube.com/watch?v=bFxnXH4-L1A (ttps://www.youtube.com/watch?v=bFxnXH4-L1A)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg)
ttps://www.youtube.com/watch?v=GqzeFYWjTxI (ttps://www.youtube.com/watch?v=GqzeFYWjTxI)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://eileenslounge.com/viewtopic.php?p=320960#p320960 (https://eileenslounge.com/viewtopic.php?p=320960#p320960)
https://eileenslounge.com/viewtopic.php?p=320957#p3209573 (https://eileenslounge.com/viewtopic.php?p=320957#p3209573)
https://eileenslounge.com/viewtopic.php?p=318868#p318868 (https://eileenslounge.com/viewtopic.php?p=318868#p318868)
https://eileenslounge.com/viewtopic.php?p=318311#p318311 (https://eileenslounge.com/viewtopic.php?p=318311#p318311)
https://eileenslounge.com/viewtopic.php?p=318302#p318302 (https://eileenslounge.com/viewtopic.php?p=318302#p318302)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317857#p317857 (https://eileenslounge.com/viewtopic.php?p=317857#p317857)
https://eileenslounge.com/viewtopic.php?p=317541#p317541 (https://eileenslounge.com/viewtopic.php?p=317541#p317541)
https://eileenslounge.com/viewtopic.php?p=317520#p317520 (https://eileenslounge.com/viewtopic.php?p=317520#p317520)
https://eileenslounge.com/viewtopic.php?p=317510#p317510 (https://eileenslounge.com/viewtopic.php?p=317510#p317510)
https://eileenslounge.com/viewtopic.php?p=317547#p317547 (https://eileenslounge.com/viewtopic.php?p=317547#p317547)
https://eileenslounge.com/viewtopic.php?p=317573#p317573 (https://eileenslounge.com/viewtopic.php?p=317573#p317573)
https://eileenslounge.com/viewtopic.php?p=317574#p317574 (https://eileenslounge.com/viewtopic.php?p=317574#p317574)
https://eileenslounge.com/viewtopic.php?p=317582#p317582 (https://eileenslounge.com/viewtopic.php?p=317582#p317582)
https://eileenslounge.com/viewtopic.php?p=317583#p317583 (https://eileenslounge.com/viewtopic.php?p=317583#p317583)
https://eileenslounge.com/viewtopic.php?p=317605#p317605 (https://eileenslounge.com/viewtopic.php?p=317605#p317605)
https://eileenslounge.com/viewtopic.php?p=316935#p316935 (https://eileenslounge.com/viewtopic.php?p=316935#p316935)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317014#p317014 (https://eileenslounge.com/viewtopic.php?p=317014#p317014)
https://eileenslounge.com/viewtopic.php?p=316940#p316940 (https://eileenslounge.com/viewtopic.php?p=316940#p316940)
https://eileenslounge.com/viewtopic.php?p=316927#p316927 (https://eileenslounge.com/viewtopic.php?p=316927#p316927)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Rick Rothstein]

The text surrounding the emails is always different (ie the emails are not surrounded by <> or any other kind of constant characters that can simplify this).

It has to be surrounded by something in order to be able to tell where it begins or ends... give us an idea of the type of characters you see on either side of it so we can get an idea how to proceed.


https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwplzlpYpmRqjGZem14AaABAg.9hrvbYRwXvg9ht4b7z00 X0 (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwplzlpYpmRqjGZem14AaABAg.9hrvbYRwXvg9ht4b7z00 X0)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgyOGlCElBSbfPIzerF4AaABAg.9hrehNPPnBu9ht4us7Tt Pr (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgyOGlCElBSbfPIzerF4AaABAg.9hrehNPPnBu9ht4us7Tt Pr)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwHjKXf3ELkU4u4j254AaABAg.9hr503K8PDg9ht5mfLcg pR (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwHjKXf3ELkU4u4j254AaABAg.9hr503K8PDg9ht5mfLcg pR)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw1-OyZiDDxCHM2Rmp4AaABAg.9hqzs_MlQu-9ht5xNvQueN (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw1-OyZiDDxCHM2Rmp4AaABAg.9hqzs_MlQu-9ht5xNvQueN)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg.9ht16tzryC49htJ6TpIO XR (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg.9ht16tzryC49htJ6TpIO XR)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg.9ht16tzryC49htOKs4jh 3M (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg.9ht16tzryC49htOKs4jh 3M)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg.9htWqRrSIfP9i-fyT84gqd (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg.9htWqRrSIfP9i-fyT84gqd)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg.9htWqRrSIfP9i-kIDl-3C9 (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg.9htWqRrSIfP9i-kIDl-3C9)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i57J9GEOUB (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i57J9GEOUB)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i58MGeM8Lg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i58MGeM8Lg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i59prk5atY (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i59prk5atY)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwaWs6XDXdQybNb8tZ4AaABAg.9i5yTldIQBn9i7NB1gjy Bk (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwaWs6XDXdQybNb8tZ4AaABAg.9i5yTldIQBn9i7NB1gjy Bk)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxV9eNHvztLfFBGsvZ4AaABAg.9i5jEuidRs99i7NUtNNy 1v (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxV9eNHvztLfFBGsvZ4AaABAg.9i5jEuidRs99i7NUtNNy 1v)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugx2zSXUtmLBSDoNWph4AaABAg.9i3IA0y4fqp9i7NySrZa md (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugx2zSXUtmLBSDoNWph4AaABAg.9i3IA0y4fqp9i7NySrZa md)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9i7Qs8kxE qH (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9i7Qs8kxE qH)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9i7TqGQYq Tz (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9i7TqGQYq Tz)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAJSNws8 Zz (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAJSNws8 Zz)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAJvZ6km lx (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAJvZ6km lx)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAK0g1dU 7i (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAK0g1dU 7i)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKCDqNm nF (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKCDqNm nF)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKHVSTG Hy (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKHVSTG Hy)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKSBKPc J6 (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKSBKPc J6)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKgL6lr cT (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKgL6lr cT)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKlts8h KZ (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKlts8h KZ)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKrX7UP P0 (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKrX7UP P0)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAL5MSjW pA (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAL5MSjW pA)

[dunndealpr]

It has to be surrounded by something in order to be able to tell where it begins or ends... give us an idea of the type of characters you see on either side of it so we can get an idea how to proceed.

Hey Rick, thanks so much for your reply. Here's an example of the text in an average column D cell.

"Thanks so much for contacting me you know you can always hit me at nadine_trotsky@yahoo.com or @nadine_trotsky on Twitter"


That's pretty average. A lot of these people are people who direct messaged me over Twitter so their Twitter name is in the thread with another @ sign, which seems like it may confuse things further. Add to that, a lot of people I know don't exactly follow proper writing rules, so there might be a character pressed right up against the beginning or the end of their email address with no space. A lot of people end the sentence with their email address, meaning there's a period at the end of .com ("nadine_trotsky.com"). It's a bit of a minefield.

Seems like the code should be set to look out for spaces and/or non-email characters, and I guess everything that doesn't catch we'll just have to chalk up as a loss..?

Thanks again, Rick.



https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3 (https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
ttps://www.youtube.com/watch?v=LP9fz2DCMBE (ttps://www.youtube.com/watch?v=LP9fz2DCMBE)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8 (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8)
ttps://www.youtube.com/watch?v=bFxnXH4-L1A (ttps://www.youtube.com/watch?v=bFxnXH4-L1A)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg)
ttps://www.youtube.com/watch?v=GqzeFYWjTxI (ttps://www.youtube.com/watch?v=GqzeFYWjTxI)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Rick Rothstein]

Give the following function a try. The first argument is the text string to parse and the optional second argument allows you to start the search from an arbitrary location within the text. If the function finds the first @ sign after the StartAt value (optional, defaulted to 1) and if that @ sign is not part of an email address, then the function returns the empty string. You will need to set up a loop that starts looking one character after each @ sign until it finds a valid email address.

Function GetEmailAddress(ByVal S As String, Optional StartAt As Long = 1) As String
Dim X As Long, AtSign As Long
Dim Locale As String, Domain As String
S = Mid(S, StartAt)
Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"
Domain = "[A-Za-z0-9._-]"
AtSign = InStr(S, "@")
If AtSign < 2 Then Exit Function
If Not Mid(S, AtSign - 1, 1) Like Locale Then Exit Function
For X = AtSign To 1 Step -1
If Not Mid(" " & S, X, 1) Like Locale Then
S = Mid(S, X)
If Left(S, 1) = "." Then S = Mid(S, 2)
Exit For
End If
Next
AtSign = InStr(S, "@")
For X = AtSign + 1 To Len(S) + 1
If Not Mid(S & " ", X, 1) Like Domain Then
S = Left(S, X - 1)
If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)
GetEmailAddress = S
Exit For
End If
Next
End Function

[Excel Fox]

I'll use a Bazooka here (sorry Rick ;)), but here's my solution


Function ExtractEmail(strInputText As String) As String

Dim regEx As Object
Dim varResults As Object
Dim varEach
Dim lng As Long
Set regEx = CreateObject("vbscript.RegExp")
regEx.Pattern = "(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|""(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])*"")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?|[a-z0-9-]*[a-z0-9]:(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21-\x5a\x53-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])+)\])"
regEx.IgnoreCase = True 'True to ignore case
regEx.Global = True 'True matches all occurances, False matches the first occurance
If regEx.Test(Range("D1").Value) Then
Set varResults = regEx.Execute(Range("D1").Value)
For lng = 1 To varResults.Count
ExtractEmail = ExtractEmail & varResults.Item(lng - 1).Value & "|||"
Next
ExtractEmail = Left(ExtractEmail, Len(ExtractEmail) - Len("|||"))
ExtractEmail = Join(Split(ExtractEmail, "|||"), ", ")
End If

End Function

[Excel Fox]

By the way, the pattern I used was from here (not my invention)

How to Find or Validate an Email Address (http://www.regular-expressions.info/email.html)

[Rick Rothstein]

By the way, the pattern I used was from here (not my invention)

How to Find or Validate an Email Address (http://www.regular-expressions.info/email.html)

And [gulp] one hell of a pattern it is...

[dunndealpr]

Hey all. Thanks so much for your time here. I saved the bazooka script as a macro and ran it, but I got a 'compile error: unexpected end sub' prompt. It seems when I created a macro called 'rickroth', Excel has added 'sub Rickroth' at the top of the code.


Sorry if I'm making a silly mistake here. I'm adept enough at using VBA script in Word but for some reason it eludes me in Excel.

[Rick Rothstein]

Hey all. Thanks so much for your time here. I saved the bazooka script as a macro and ran it, but I got a 'compile error: unexpected end sub' prompt. It seems when I created a macro called 'rickroth', Excel has added 'sub Rickroth' at the top of the code.

I am not sure what you are saying here.... the code Excel Fox and I posted are not macros, they are functions meant to be called by other code (macros, event, etc.) or used as a function within a worksheet formula. Please explain exactly what you did and what happened when you did it.

[dunndealpr]

I am not sure what you are saying here.... the code Excel Fox and I posted are not macros, they are functions meant to be called by other code (macros, event, etc.) or used as a function within a worksheet formula. Please explain exactly what you did and what happened when you did it.

currently browsing Excel 2007 For Dummies for a tutorial on how to insert this script properly. I know I should really know this kind of thing before coming to you guys, but if you can hit me with a link that explains how to do this, it would save me a lot of hair today. Sorry.

[dunndealpr]

I go to Visual Basic - Insert - New Module, I paste the code then I hit F5 then i get this prompt (see attached)843

[Rick Rothstein]

I go to Visual Basic - Insert - New Module, I paste the code then I hit F5 then i get this prompt (see attached)

The installation part (where you paste it) is correct, but as I said previously, what you pasted is not a macro... it is a function and you it just like any other function in VB. For example, you have no problem using, say, the Int function, do you? My guess is no... just do the same thing with either my function or the one Excel Fox posted, but use the name of whichever function you pasted instead of Int. Functions, whether built-in or written by me, Excel Fox, or any one else, all do the same thing... they usually (but not always) let you pass in values (called arguments) and the all return a value which can be used directly inside an expression (in VBA) or in a formula in a worksheet cell.

[dunndealpr]

Hey Rick, I got an email seeing your last reply to this thread but I don't see it anywhere on the actual thread. Weird...

Anyway, I can insert module and paste script just fine. It's the actual running of it that eludes me. I press F5 and the Macros window comes up.

[dunndealpr]

Got it. So once I've pasted the code into a module, what do I do to run it?

[Rick Rothstein]

You do not run functions (you run macros), you use functions to return a value to you. Once you have pasted (I'll assume my code because I'll be using my function's name below) into the module, go to any worksheet and put this in cell A1...

This is a test line with this (one.two@three.four.com) strange email address

Now, put this in cell A2 and I think all will become clear (well, I hope so because I am going to sleep now)...

=GetEmailAddress(A1)

[dunndealpr]

I see now! It's working! Thanks for your patience. Last stupid question. What do I enter in place of A1 to make this script run on multiple rows?

[Excel Fox]

Just drag the formula down all the way

[dunndealpr]

Just drag the formula down all the way

OK, so I've attached the test document I'm working with. Two questions.

1) When I enter =ExtractEmail(A1) and hit enter, I see nothing. Blank cell. When I save and close and re-open, I see the extracted email. What gives?

2) When you say "just drag the formula down all the way" do you mean select all the cells in column B next to the ones you want answers for, and then enter =ExtractEmail(A1:A5) and hit enter? Because when I do that I get #VALUE!


Thanks again.

[bakerman]

Use the function like this

Function ExtractEmail(strInputText As String) As String

Dim regEx As Object
Dim varResults As Object
Dim varEach
Dim lng As Long
With CreateObject("vbscript.RegExp")
.Pattern = "(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|""(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])*"")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?|[a-z0-9-]*[a-z0-9]:(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21-\x5a\x53-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])+)\])"
.IgnoreCase = True 'True to ignore case
.Global = True 'True matches all occurances, False matches the first occurance
If .Test(strInputText) Then
Set varResults = .Execute(strInputText)
For lng = 1 To varResults.Count
ExtractEmail = ExtractEmail & varResults.Item(0).Value & "|||"
Next
ExtractEmail = Left(ExtractEmail, Len(ExtractEmail) - Len("|||"))
ExtractEmail = Join(Split(ExtractEmail, "|||"), ", ")
End If
End With
End Function

To drag the formula down, grab the little square in the bottom-right corner of B1 and pull down

[Rick Rothstein]

OK, so I've attached the test document I'm working with. Two questions.

1) When I enter =ExtractEmail(A1) and hit enter, I see nothing. Blank cell. When I save and close and re-open, I see the extracted email. What gives?

2) When you say "just drag the formula down all the way" do you mean select all the cells in column B next to the ones you want answers for, and then enter =ExtractEmail(A1:A5) and hit enter? Because when I do that I get #VALUE!

The problem is the Excel Fox has an "error" (of sorts) in the code he posted. This the code he posted and that you are using...

Function ExtractEmail(strInputText As String) As String
Dim regEx As Object
Dim varResults As Object
Dim varEach
Dim lng As Long
Set regEx = CreateObject("vbscript.RegExp")
regEx.Pattern = "(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|""(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])*"")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?|[a-z0-9-]*[a-z0-9]:(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21-\x5a\x53-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])+)\])"
regEx.IgnoreCase = True 'True to ignore case
regEx.Global = True 'True matches all occurances, False matches the first occurance
If regEx.Test(Range("D1").Value) Then
Set varResults = regEx.Execute(Range("D1").Value)
For lng = 1 To varResults.Count
ExtractEmail = ExtractEmail & varResults.Item(0).Value & "|||"
Next
ExtractEmail = Left(ExtractEmail, Len(ExtractEmail) - Len("|||"))
ExtractEmail = Join(Split(ExtractEmail, "|||"), ", ")
End If

End Function

I highlighted the problem in red. Apparently, Excel Fox tested his code using a direct reference to cell D1, then when he converted it to a function for posting, he forgot to change those two references to the argument name used in the function's declaration header (strInputText)... just replace both red highlighted text with strInputText and the code should work fine. Just wondering if you tested my code or not (it would have worked directly).

[bakerman]

@ Rick

See post #19

[snb]

An alternative approach, see the attachment

[Rick Rothstein]

An alternative approach, see the attachment
Your code uses spaces as the delimiter which means that for text like this...

testing (jill@gmail.com) this

it returns this...

(jill@gmail.com)

rather than this...

jill@gmail.com

And, of course, it will retain other adjacent non-email-characters as well. If you look at the code I posted, those characters are not retained with the email address itself.

[dunndealpr]

hey Rick. Just tried yours and snb's and they both work, thank you again. What I'm still stumped on is how to make it work for multiple rows at once.

An earlier commenter said "just drag the formula down all the way". Does that mean select all the cells in column B next to the ones you want answers for, and then enter =ExtractEmail(A1:A5) and hit enter? Because when I do that I get #VALUE!

[Rick Rothstein]

hey Rick. Just tried yours and snb's and they both work, thank you again.

Look at Message #23 where I advise that snb's posted function does not remove punctuation marks next to the email address (my guess is you tested his function with a simple text string where the email address stood alone surrounded only be spaces.



What I'm still stumped on is how to make it work for multiple rows at once.

An earlier commenter said "just drag the formula down all the way". Does that mean select all the cells in column B next to the ones you want answers for, and then enter =ExtractEmail(A1:A5) and hit enter? Because when I do that I get #VALUE!
Assuming you have text in A1 to, say, A10, put the formula in B1 and, with B1 selected, hover your cursor over the small black square in the bottom right corner of B1 (the selected cell) until the cursor becomes what looks like a plus sign, then click and drag down to B10... the address references in the formula will automatically adjust for their new location. You can achieve the same result by selecting B1 (after you put the formula in it), copying it, then selecting B1:B10 and pasting.

[dunndealpr]

Holy cow. It works! I cannot thank you guys enough. I hope you're rich.

Thank you again.

[Excel Fox]

For posterity, the 'bazooka' function uses a heavy-duty regular expression (it was Rick who coined it that way in one of our threads, so I'll pass the credit to him for the catchy name).

Just for the record though, the function that I posted (revised one below) will extract more than one email address from the string, should it contain that many.



Function ExtractEmail(strInputText As String) As String

Dim regEx As Object
Dim varResults As Object
Dim varEach
Dim lng As Long
With CreateObject("vbscript.RegExp")
.Pattern = "(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|""(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])*"")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?|[a-z0-9-]*[a-z0-9]:(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21-\x5a\x53-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])+)\])"
.IgnoreCase = True 'True to ignore case
.Global = True 'True matches all occurances, False matches the first occurance
If .Test(strInputText) Then
Set varResults = .Execute(strInputText)
For lng = 1 To varResults.Count
ExtractEmail = ExtractEmail & varResults.Item(lng - 1).Value & "|||"
Next
ExtractEmail = Left(ExtractEmail, Len(ExtractEmail) - Len("|||"))
ExtractEmail = Join(Split(ExtractEmail, "|||"), ", ")
End If
End With
End Function

[Rick Rothstein]

Just for the record though, the function that I posted (revised one below) will extract more than one email address from the string, should it contain that many.

Excellent idea Excel Fox! Here is my code modified to do the same thing...

Function GetEmailAddress(Sin As String) As String
Dim X As Long, AtSign As Long, AtSign2 As Long, StartAt As Long, S As String, subS As String
Dim Locale As String, Domain As String
Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"
Domain = "[A-Za-z0-9._-]"
StartAt = 1
Do
S = Mid(Sin, StartAt)
AtSign = InStr(StartAt, S, "@")
If AtSign < 2 Then Exit Do
If Mid(S, AtSign - 1, 1) Like Locale Then
For X = AtSign To 1 Step -1
If Not Mid(" " & S, X, 1) Like Locale Then
subS = Mid(S, X)
If Left(subS, 1) = "." Then subS = Mid(subS, 2)
Exit For
End If
Next
AtSign2 = InStr(subS, "@")
For X = AtSign2 + 1 To Len(subS) + 1
If Not Mid(subS & " ", X, 1) Like Domain Then
subS = Left(subS, X - 1)
If Right(subS, 1) = "." Then subS = Left(subS, Len(subS) - 1)
GetEmailAddress = GetEmailAddress & ", " & subS
Exit For
End If
Next
End If
StartAt = AtSign + 1
Loop
GetEmailAddress = Mid(GetEmailAddress, 3)
End Function

[snb]

I assumed the OP had email addresses in sentences, so I assumed every email address being encapsulated by spaces. Based on his feedback I conclude my assumption was correct.
So I won't try to match Rick's 'overkill' (:stick:) code. Sufficient is enough I'd say ;)

[Rick Rothstein]

I assumed the OP had email addresses in sentences, so I assumed every email address being encapsulated by spaces. Based on his feedback I conclude my assumption was correct.

From the OP's posting in Message #3...

"Add to that, a lot of people I know don't exactly follow proper writing rules, so there might be a character pressed right up against the beginning or the end of their email address with no space. A lot of people end the sentence with their email address, meaning there's a period at the end of .com."

[snb]

But that was yesterday....;)

[Excel Fox]

ohohoho.... I didn't know snb could take the slippery side too %p

[Rick Rothstein]

But that was yesterday....;)
That is too funny! :laugh:

[Rick Rothstein]

I assumed the OP had email addresses in sentences, so I assumed every email address being encapsulated by spaces. Based on his feedback I conclude my assumption was correct.

By the way, if you are correct and the OP's email addresses are separated by spaces, and if (and this is a big if) the email address will always come before any other text (Twitter or whatever) with an asterisk, and ignoring the fact the OP said he wanted a VBA solution:surprise:, there is a formula solution to be had...

=TRIM(RIGHT(SUBSTITUTE(LEFT(A1,FIND("@",A1)-1)," ",REPT(" ",500)),500))&MID(A1,FIND("@",A1),FIND (%22,500)),500))&MID(A1,FIND(%22@%22,A1),FIND)(" ",A1&" ",FIND("@",A1))-FIND("@",A1))

[dunndealpr]

hey all! been working with these codes a couple of days. Rick's most recent 'getemailaddress' code results in #NAME? straight down the line for me.
Excel Fox's most recent 'extractemail' code works, but the email address themselves are not reflected in the formula fields. Instead of seeing the email address in the formula field up top I see the formula itself. Is this normal?

[dunndealpr]

I've also noticed the 'extractemail' code is missing quite a few emails. I've attached a document with three examples of text it was unable to extract emails from. Any ideas?

[Rick Rothstein]

hey all! been working with these codes a couple of days. Rick's most recent 'getemailaddress' code results in #NAME? straight down the line for me.

Just so you know, my code works fine, even against the email addresses in the file you posted in Message #36 (I just tested it). If you are getting a #NAME? error, it is because you did one of two things wrong... either you put the code in the wrong place (it needs to go in a general Module, the same kind of module that macros go in) or you spelled the function name incorrectly when you used it in your formula. I will say, though, that my function (and I would guess most other functions) will return the wrong text for the first email address in your posted file, namely this one...

"thanks for the email man hit me at moneymankp@yahoo.com.LOOKING FOR MANAGEMENT!!!"

My function will return moneymankp@yahoo.com.LOOKING as the email address, not moneymankp@yahoo.com which is what you would be wanting it to. Notice that the quoted text above also assumes moneymankp@yahoo.com.LOOKING is the email address (it should be highlighted in blue and underlined)... that is because an email address can have more than one dot after the @ sign and because LOOKING are all valid characters for use in an email address.



Excel Fox's most recent 'extractemail' code works, but the email address themselves are not reflected in the formula fields. Instead of seeing the email address in the formula field up top I see the formula itself. Is this normal?
It sounds like you put the formula in a cell formatted as TEXT. Try changing the cell format to General and then re-enter the formula.

[dunndealpr]

Thanks Rick! Both suggestions worked like a charm.

[Excel Fox]

My function will also return the same email address that Rick's returns, ie moneymankp@yahoo.com.LOOKING

Again, one of the patterns
\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b suggested in the url link I posted in post # 6, gives an output that you'd normally expect, ie. moneymankp@yahoo.com

Of course in this case, you won't get email address that contain two dots (.)

That's a trade-off decision user has to take.

[dunndealpr]

Just so you know, my code works fine, even against the email addresses in the file you posted in Message #36 (I just tested it). If you are getting a #NAME? error, it is because you did one of two things wrong... either you put the code in the wrong place (it needs to go in a general Module, the same kind of module that macros go in) or you spelled the function name incorrectly when you used it in your formula. I will say, though, that my function (and I would guess most other functions) will return the wrong text for the first email address in your posted file, namely this one...

"thanks for the email man hit me at moneymankp@yahoo.com.LOOKING FOR MANAGEMENT!!!"

My function will return moneymankp@yahoo.com.LOOKING as the email address, not moneymankp@yahoo.com which is what you would be wanting it to. Notice that the quoted text above also assumes moneymankp@yahoo.com.LOOKING is the email address (it should be highlighted in blue and underlined)... that is because an email address can have more than one dot after the @ sign and because LOOKING are all valid characters for use in an email address.



It sounds like you put the formula in a cell formatted as TEXT. Try changing the cell format to General and then re-enter the formula.


Hey Rick, this workaround for the cell formats has not been working for me. In the actual field I see the email address, but in the formula field I'll see something to the effect of =extractemail(F2035), and selecting the General cell format both before and after applying the formula does not change this. My only option has been to save the file as a csv, but that also removes all kinds of highlighting that I have on the files. Do you have any other ideas about how I can fix this problem?

Thanks again for your help with all this.

[Rick Rothstein]

Hey Rick, this workaround for the cell formats has not been working for me. In the actual field I see the email address, but in the formula field I'll see something to the effect of =extractemail(F2035), and selecting the General cell format both before and after applying the formula does not change this.

The Formula Bar (think about its name) shows the formula in the cell, the cell shows what the formula evaluates to.... this is standand Excel functionality. The only way the Formula Bar will show what the cell displays is if the cell contains a non-formula value (that is, a constant value that was typed in or copy/pasted in). If you want the Formula Bar to show the same thing as the cell, select all the cells you want this to happen for, then press CTRL+C to copy the cells into the Clipboard, then with the same cells selected, right-click the selection and choose "Paste Special" from the popup menu that appears and select the Values option button... after you do that and then click OK, all the formulas will be converted to the constant values they evaluated to. NOTE though, you will have then lost the formulas.

[dunndealpr]

Thanks Rick, that worked. The issue was that when I would ctrl-x a row then ctrl-v it somewhere else, the email address your formula found for me would turn into #NAME?, along with every other email address in that column.

[Manfred]

Thanks for sharing, i have the same problem so i will try with these steps. However i will be looking for other theme to find more information.

[LittleGirl]

Hi,

im doing an intern ship here and found after a few hours your piece of code which works quite good. But its is so complex that i have no chance to change it to my needs.

I have data which i have to prepare. In this data there are a lot of customer infos like phone number, date, email, adress, names i have to get rid of.

Is there a possibility to change the code a bit. I just have to find aout if there is an EMail and replace it with "E-MAil" instead of taking it out. But i need no real verification. Sometimes the E-Mail adresses are invalid.

if found following scenarios which have to be found and replaced:

1. xxx@xxx.xx
2. @xxxx.xx
3. xxxxx@
4. @

Thx a lot in advance!
Julia