View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
AndrewArmstrong AndrewArmstrong is offline
external usenet poster
 
Posts: 24
Default find a value in a column then copy next few rows

This should do what you're looking for, if I understood you correctly,
let me know if you need it revised.

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
Next c

Range(strcol & "1").Select


End Sub