Separating Emails

Z

zinah

Active Member
Joined
Nov 28, 2018
Messages
368
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have below that have "email / name". Is there any way that I can remove the names and the extra space below each email and keep only emails?

Email/NameExpected Results
a@abc.com / A b@abc.com / Ba@abc.com b@abc.com
a@abc.com / A f@abc.com / Fa@abc.com f@abc.com
d@abc.com / D e@abc.com / E f@abc.com / F
d@abc.com / D e@abc.com / E g@abc.com / G a@abc.com / A
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Try in 'D2' cell and copy down.
Format cells -> Wrap Text
Code: 
=TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(A1)))*99-98,99))&
CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B1)))*99-98,99)),1)+1,255),"")&
CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C1)))*99-98,99)),1)+1,255),"")&
CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D1)))*99-98,99)),1)+1,255),"")
 

Attachments

  • zinah.png
    zinah.png
    7 KB · Views: 22
Upvote 0
You could try this macro.

VBA Code: 
Sub ExtractEmails()
  Dim RX As Object
  Dim a As Variant, b As Variant
  Dim i As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = " [^@]+( |$)"
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    b(i, 1) = Replace(RTrim(RX.Replace(a(i, 1), " ")), " ", vbLf)
  Next i
  Range("B2").Resize(UBound(b)).Value = b
End Sub

My sample data and results:

zinah.xlsm
AB
1Email/NameResults
2a@abc.com / A b@abc.com / Ba@abc.com b@abc.com
3a@abc.com / A f@abc.com / Fa@abc.com f@abc.com
4d@abc.com / D e@abc.com / E f@abc.com / Fd@abc.com e@abc.com f@abc.com
5d@abc.com / D e@abc.com / E g@abc.com / G a@abc.com / Ad@abc.com e@abc.com g@abc.com a@abc.com
Sheet1
 
Upvote 0
navic said:
Try in 'D2' cell and copy down.
Format cells -> Wrap Text
Code: 
=TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(A1)))*99-98,99))&
CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B1)))*99-98,99)),1)+1,255),"")&
CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C1)))*99-98,99)),1)+1,255),"")&
CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D1)))*99-98,99)),1)+1,255),"")
Click to expand...
Thank you for your help!
I copied your formula and couldn't get the expected results. Not sure how to translate your formula but I noticed you included Columns B1, C1 and D1. Below is what I got after copying your suggested formula:

Test File_Mapping.xlsx
ABCD
1Email/NameExpected ResultsSuggested Formula
2a@abc.com / A b@abc.com / Ba@abc.com b@abc.coma@abc.com
3a@abc.com / A f@abc.com / Fa@abc.com f@abc.coma@abc.com
4d@abc.com / D e@abc.com / E f@abc.com / F d@abc.com
5d@abc.com / D e@abc.com / E g@abc.com / G a@abc.com / A d@abc.com
Sheet2
Cell Formulas
RangeFormula
D2:D5D2=TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(A1)))*99-98,99))& CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B1)))*99-98,99)),1)+1,255),"")& CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C1)))*99-98,99)),1)+1,255),"")& CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D1)))*99-98,99)),1)+1,255),"")
 
Upvote 0
Peter_SSs said:
You could try this macro.

VBA Code: 
Sub ExtractEmails()
  Dim RX As Object
  Dim a As Variant, b As Variant
  Dim i As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = " [^@]+( |$)"
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    b(i, 1) = Replace(RTrim(RX.Replace(a(i, 1), " ")), " ", vbLf)
  Next i
  Range("B2").Resize(UBound(b)).Value = b
End Sub

My sample data and results:

zinah.xlsm
AB
1Email/NameResults
2a@abc.com / A b@abc.com / Ba@abc.com b@abc.com
3a@abc.com / A f@abc.com / Fa@abc.com f@abc.com
4d@abc.com / D e@abc.com / E f@abc.com / Fd@abc.com e@abc.com f@abc.com
5d@abc.com / D e@abc.com / E g@abc.com / G a@abc.com / Ad@abc.com e@abc.com g@abc.com a@abc.com
Sheet1
Click to expand...
Thank you so much for your help and suggested macro! After copying your macro into my sheet, below is the result that I got, not sure what went wrong, the blanks are still there:

Test File_Mapping.xlsm
AB
1Email/NameResults
2a@abc.com / A b@abc.com / Ba@abc.com A b@abc.com
3a@abc.com / A f@abc.com / Fa@abc.com A f@abc.com
4d@abc.com / D e@abc.com / E f@abc.com / F d@abc.com D e@abc.com E f@abc.com
5d@abc.com / D e@abc.com / E g@abc.com / G a@abc.com / A d@abc.com D e@abc.com E g@abc.com G a@abc.com
Sheet2
 
Upvote 0
How about (max 4 email lines)
- wrap text ?
- resize column ?
Code: 
CLEAN(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(A1)))*99-98,99))&" "&
MID(TRIM(MID(SUBSTITUTE($A2,"/ ",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B$1)))*99-98,99)),2,255)&" "&
MID(TRIM(MID(SUBSTITUTE($A2,"/ ",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C$1)))*99-98,99)),2,255)&" "&
MID(TRIM(MID(SUBSTITUTE($A2,"/ ",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D$1)))*99-98,99)),2,255))
 

Attachments

  • zinah2.png
    zinah2.png
    15.8 KB · Views: 18
Upvote 0
navic said:
How about (max 4 email lines)
- wrap text ?
- resize column ?
Code: 
CLEAN(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(A1)))*99-98,99))&" "&
MID(TRIM(MID(SUBSTITUTE($A2,"/ ",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B$1)))*99-98,99)),2,255)&" "&
MID(TRIM(MID(SUBSTITUTE($A2,"/ ",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C$1)))*99-98,99)),2,255)&" "&
MID(TRIM(MID(SUBSTITUTE($A2,"/ ",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D$1)))*99-98,99)),2,255))
Click to expand...
I did resize the column and wrap the text, however the results were not as I was expected. Only the first email was there, and what I need is to get all the emails that are listed in the cell. Looking back at your screenshot when you suggested the formula, not sure how you got these results and I didn't, I copied exactly your formula but didn't get your results (which are the exact results that I'm looking for).

Test File_Mapping.xlsm
ABCD
1Email/NameSuggested Formula
2a@abc.com / A b@abc.com / Ba@abc.com
3a@abc.com / A f@abc.com / Fa@abc.com
4d@abc.com / D e@abc.com / E f@abc.com / F d@abc.com
5d@abc.com / D e@abc.com / E g@abc.com / G a@abc.com / A d@abc.com
Sheet2
Cell Formulas
RangeFormula
D2:D5D2=TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(A1)))*99-98,99))& CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(B1)))*99-98,99)),1)+1,255),"")& CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(C1)))*99-98,99)),1)+1,255),"")& CHAR(10)&IFERROR(MID(TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D1)))*99-98,99)),SEARCH(" ",TRIM(MID(SUBSTITUTE($A2," /",REPT(" ",99)),ROW(INDIRECT("A$"&COLUMN(D1)))*99-98,99)),1)+1,255),"")
 
Upvote 0
zinah said:
Thank you so much for your help and suggested macro! After copying your macro into my sheet, below is the result that I got, not sure what went wrong, the blanks are still there:
Click to expand...
Try this version. It is just the 'Pattern' line that has changed.

Rich (BB code): 
Sub ExtractEmails()
  Dim RX As Object
  Dim a As Variant, b As Variant
  Dim i As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = " [^@]+( |" & vbLf & "|$)"
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    b(i, 1) = Replace(RTrim(RX.Replace(a(i, 1), " ")), " ", vbLf)
  Next i
  Range("B2").Resize(UBound(b)).Value = b
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

D
  • Question
send an email notification when the value of the cell is selected in the drop down as Completed.
Replies
0
Views
502
danielz86
D
M
  • Question
VBA Worksheet Change Todays Date Auto Email SharePoint
Replies
0
Views
373
MixedUpExcel
M
B
  • Solved
Replace multiple spaces in names with different values
Replies
3
Views
424
Peter_SSs
Peter_SSs
D
  • Solved
Update a list of files in Sheet1 using a partial match and then latest date (formatted YYYYMMDD)
Replies
4
Views
493
ddander54
D
R
  • Solved
Help needed with Excel VBA code for sending E-mails only to people based on project status change condition
Replies
4
Views
2K
Micron
M

Forum statistics

Threads
1,221,310
Messages
6,159,173
Members
451,543
Latest member
cesymcox

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