Hi ther,e

I've got a doozy for everyone, I've got a spreadsheet with one column. The
data in the column is an extract of a large number of emails that get
generated through a group mailbox. What I'm trying to do is extract the body
data from those emails into a seperate worksheet to look at the data.

I've extracted the email to a txt file and it's in Excel, my first column
looks like this:

From:
Posted At:
Conversation:
Posted To:

Subject:

View Work Order
<http://www.homepage.com/123456

Comments:
This workorder needed a revision because of material delays

If you require further information,
please contact


The data repeats itself several hundred times.
What I would like to do is Extract all of the Comments and put it into a new
worksheet to look at why revisions were made.

I've been scowering the internet and I've got this snippit of code. It
presents a screen to the user to find a value. I enter "Comments:" then it
copies that line to another worksheet called sheet2.

I'm stuck trying to get it to search for the next cell below Comments that
contains the text "From:" and copy all of the cells inbetween to a new sheet.


Any ideas?

Thanks in advance.

Sub ExtractComments()
'
' ExtractComments Macro
' Macro recorded 23/05/2008 by Grant Ferdinands
'

Dim strLastRow As String
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Dim rngtest As String
Application.ScreenUpdating = False

Set wSht = Worksheets("Sheet2")
strToFind = InputBox("Enter the value to find")

With ActiveSheet.Range("A1:A23331")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
strLastRow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
rngC.EntireRow.Copy wSht.Cells(strLastRow, 1)
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address < FirstAddress
End If
End With

MsgBox ("Finished")

End Sub