Separating Emails

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

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
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
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),"")
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
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
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
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))
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
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:
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

Forum statistics

Threads
1,223,248
Messages
6,171,011
Members
452,374
Latest member
keccles

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