I need help please. I need to extract the following from the message
bellow:
1.the email
2.Postcode: SE55 2LN
3 This message has been scanned for viruses at Samuel and Sons Ltd. in
2000 cells.

Range("B2").Select

While ActiveCell.Value < ""

Str = ActiveCell.Value
'MsgBox ("") & Len(Str)
Cnt = 1
CntPart = 0
For x = 1 To Len(Str)
If Asc(Mid(Str, x, 1)) = 10 Or Asc(Mid(Str, x, 1)) = 13
Then
'MsgBox Asc(Mid(Str, X, 1))
'MsgBox CntPart
CntPart = CntPart + 1
Strparts(CntPart) = ""
'MsgBox Strparts(CntPart)
Else
'MsgBox Asc(Mid(Str, X, 1))
'MsgBox CntPart
Strparts(CntPart) = Strparts(CntPart) & Mid(Str, x, 1)
'MsgBox Strparts(CntPart)
End If
Next x



Worksheets("Report").Select
'Range("A1").Select


For Z = 1 To CntPart
ActiveCell.FormulaR1C1 = Strparts(Z)
ActiveCell.Offset(0, 1).Select
Next Z
ActiveCell.Offset(1, -(CntPart)).Select


For Each wkshts In Worksheets
If Left(wkshts.Name, 5) = "alert" Then
dataworksheetselect = wkshts.Name
End If
Next

Worksheets(dataworksheetselect).Select
ActiveCell.Offset(1, 0).Select

Wend
used the above code but it only loops through and does not return
anything


"A user has registered at www.XXXXXXXXXXXXXXXXX.com and took up the
option to be contacted by their local Business Link for occasional
updates. Their postcode showed that they are in the area covered by
you, so their email address is given below. We invite you to add them
to your email list, provided your emailing activities are in line with
our privacy policy at www.XXXXXXXXXXXXX.com/privacy and that every
email you send has instructions about how to unsubscribe from future
emails sent by you.



Postcode: SE55 2LN



This message has been scanned for viruses at Samuel and Sons Ltd.

"