T
Teltech
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 (e-mail address removed)
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
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 (e-mail address removed)
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