Thank you so much! I've been trying to get this darn thinking working forever!



One more thing though..... Any idea how to change the color of the cell
inbetween copies? or add some sort of "===========================" to the
cell to seperate the comments?


"AndrewArmstrong" wrote:

Sorry, it wrapped some lines, use this one"

Sub MailFilter()

'Prompt User for Column with Data
Dim strcol As String
strcol = InputBox("What Column contains the data?", _
"Filter E-mail Data", "A")

'Find the lastcell in the column with the text data
Dim lnglastrowcol As Long
lnglastrowcol = Range(strcol & "65536").End(xlUp).Row

'choose the range to be used
Dim rng As Range
Set rng = Range(strcol & "1", strcol & lnglastrowcol)

For Each c In rng
If InStr(1, c.Value, "Comments:") 0 Then
'find the cell with "From:"
Dim intcurrentrow As Integer
intcurrentrow = c.Row
Dim introwcount As Integer
introwcount = 0
Do Until InStr(1, c.Offset(introwcount, 0), "From:") 0 Or _
introwcount = lnglastrowcol
'c.Offset(1, 0).Select
introwcount = introwcount + 1
Loop
'Select and copy the desired range
Range(strcol & intcurrentrow + 1, strcol & introwcount + _
intcurrentrow - 1).Copy
'Paste to sheet 2 at the end of the last comment
Dim lnglastrow2 As Long
lnglastrow2 = Sheets(2).Range(strcol & "65536").End(xlUp).Row
ActiveSheet.Paste Destination:=Sheets(2).Range(strcol _
& lnglastrow2 + 1)

End If