Email from Specific Term

[Blessy Clara]

Hi

I have an excel sheet with Columns Running from 1 to 150 - First row is header

Example [TABLE="width: 500"]
<tbody>[TR]
[TD]Col1[/TD]
[TD]Col2[/TD]
[TD]Col....[/TD]
[TD]Col120[/TD]
[TD]Col130[/TD]
[TD]Col150[/TD]
[/TR]
[TR]
[TD]principal@alphass.eq.edu.au[/TD]
[TD]0517_PandC@eq.edu.au[/TD]
[TD]EQInternational@dete.qld.gov.au[/TD]
[TD]nmcca106@eq.edu.au[/TD]
[TD]accounts@helpinghandsnetwork.com.au[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]the.principal@wondaiss.eq.edu.au[/TD]
[TD]admin@wondaiss.eq.edu.au[/TD]
[TD]InternationalStudy@murrumbassc.eq.edu.au[/TD]
[TD]UniformShop@tannsandss.eq.edu.au[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]the.principal@redlynchsc.eq.edu.au/principal@redlyncsc.eq.edu.au[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]oakleighoshc@gmail.com[/TD]
[TD][/TD]
[TD]the.principal@nundahss.eq.edu.au[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I want to pull out emails with specific terms - Example Principal Email

[TABLE="width: 500"]
<tbody>[TR]
[TD]Col1[/TD]
[TD]Col2[/TD]
[TD]Col....[/TD]
[TD]Col120[/TD]
[TD]Col130[/TD]
[TD]Result[/TD]
[/TR]
[TR]
[TD]principal@alphass.eq.edu.au[/TD]
[TD]0517_PandC@eq.edu.au[/TD]
[TD]EQInternational@dete.qld.gov.au[/TD]
[TD]nmcca106@eq.edu.au[/TD]
[TD]accounts@helpinghandsnetwork.com.au[/TD]
[TD]principal@alphass.eq.edu.au[/TD]
[/TR]
[TR]
[TD]the.principal@wondaiss.eq.edu.au[/TD]
[TD]admin@wondaiss.eq.edu.au[/TD]
[TD]InternationalStudy@murrumbassc.eq.edu.au[/TD]
[TD]UniformShop@tannsandss.eq.edu.au[/TD]
[TD][/TD]
[TD][TABLE="width: 500"]
<tbody>[TR]
[TD]the.principal@wondaiss.eq.edu.au

[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]the.principal@redlynchsc.eq.edu.au/principal@redlyncsc.eq.edu.au[/TD]
[TD][/TD]
[TD][/TD]
[TD]the.principal@redlynchsc.eq.edu.au/principal@redlyncsc.eq.edu.au[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]oakleighoshc@gmail.com[/TD]
[TD][/TD]
[TD]the.principal@nundahss.eq.edu.au[/TD]
[TD][/TD]
[TD][TABLE="width: 500"]
<tbody>[TR]
[TD]the.principal@nundahss.eq.edu.au

[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Thank you in advance

 

[DanteAmor]

Where do you want to put them?
It can be in column A of another sheet

Try this macro, change the data in red for your data.

Sub pull_email()


    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim j As Long, r As Range, b As Range, celda As String, specific As String
    
    Set sh1 = Sheets("[B][COLOR=#ff0000]Sheet1[/COLOR][/B]")
    Set sh2 = Sheets("[B][COLOR=#ff0000]Sheet2[/COLOR][/B]")
    specific = "[B][COLOR=#ff0000]Principal[/COLOR][/B]"
    
    
    sh2.Cells.ClearContents
    j = 2
    
    Set r = sh1.Cells
    Set b = r.Find(specific, LookAt:=xlPart, LookIn:=xlValues)
    If Not b Is Nothing Then
        celda = b.Address
        Do
            'detalle
            sh2.Cells(j, "A").Value = b.Value
            j = j + 1
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
    End If
    MsgBox "End"
    
End Sub

Let me know if you have any doubt.

 

[Blessy Clara]

Hi DanteAmor

Wow !!

Thanks alot for your time and response - very helpful

 

[DanteAmor]

I'm glad to help you. I appreciate your kind comments.

 

[Blessy Clara]

Hi DanteAmor

One more specificity - I want to retain the ID number of the email row
example - if ID number 5 is blank and 6 has an email i want it to be pulled as per ID - so 5 is blank in result and 6 has the email ...kindaa

This code has given me all the principal emails but i am unable to match from which Org the email has been pulled - so could you please help me with that - Sorry for having missed this point

 

[DanteAmor]

You can put examples explaining what you need, maybe you can upload an image or your file to the cloud.
There you explain with detail what you need.

You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[Blessy Clara]

https://www.dropbox.com/s/f9p16rdn2xine3c/Email_Split.xlsx?dl=0

Hi DanteAmor Thanks for the Guidance - This is the Link to the Data Sample

Sample = How the data looks
Result = this is how i require the Data

Basically from all the 200+ columns I want to extract or pull only Principal Emails
I want the ID Number for the respective Email - so that i can merge the extracted Principal Emails with the Main database

 

[DanteAmor]

Use this

Sub pull_email()


    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim j As Long, r As Range, b As Range, celda As String, specific As String
    
    Set sh1 = Sheets("Sample")
    Set sh2 = Sheets("Result")
    specific = "Principal"
    
    sh2.Cells.ClearContents
    sh1.Columns("A:B").Copy sh2.Range("A1")
    
    Set r = sh1.Range("B2", sh1.Cells(Rows.Count, Columns.Count))
    Set b = r.Find(specific, LookAt:=xlPart, LookIn:=xlValues)
    If Not b Is Nothing Then
        celda = b.Address
        Do
            'detalle
            If sh2.Cells(b.Row, "B").Value = "" Then
                sh2.Cells(b.Row, "B").Value = b.Value
            End If
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
    End If
    MsgBox "End"
    
End Sub

 

[Blessy Clara]

Hi DanteAmor

Thank you - If I change specific = "Principal" this line to admin or any other term will i be able to use this code for other specific terms as required ?
If i want to pull out all emails containing the term admin or info ?

What must I do to modify the code so that i can use it as stated above

I tried for Keyword - Principal - It was absolutely great - when i changed the key term to info or admin i am not getting the specific emails but principal emails are also getting mixed - Could you please advise

 

[DanteAmor]

Use this

Sub pull_email()


    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim j As Long, r As Range, b As Range, celda As String, specific As String
    
    Set sh1 = Sheets("Sample")
    Set sh2 = Sheets("Result")
    specific = "info"
    
    sh2.Cells.ClearContents
    sh1.Columns("A").Copy sh2.Range("A1")
    sh2.Range("B1").Value = specific
    
    Set r = sh1.Range("B2", sh1.Cells(Rows.Count, Columns.Count))
    Set b = r.Find(specific, LookAt:=xlPart, LookIn:=xlValues)
    If Not b Is Nothing Then
        celda = b.Address
        Do
            'detalle
            If sh2.Cells(b.Row, "B").Value = "" Then
                sh2.Cells(b.Row, "B").Value = b.Value
            End If
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
    End If
    MsgBox "End"
    
End Sub