Find text based on common ID - vba

Question

I am trying to find text based on a common phrase. The thing is, the text that I will need to copy out is below the text that I will be searching. For example:
7.  Amazon emailed seller
Friday, February 2, 2018
"Amazon emailed seller" will be consistent, but I need the date that is below it.
Another example:
Claim Amount:
14.97
"Claim Amount:" will be consistent, but I need the amount that is below it.
In the end I am wanting to create a macro (or VBA function if macro is not possible, I apologize for not knowing) that will allow me to search on "Claim Amount:"/"Amazon emailed seller" or another common phrase and will then move the contents of the cell below them to another cell in another workbook. I will not have a cell location for the search to reference because the information I am exporting pastes differently into Excel each time.
Please let me know if you have any questions or if I should clarify anything. I am new to this website and not exactly sure how to phrase my question to be as clear as possible. My apologies in advance.
Thank you!

Answer 1

Here is a fast approach using a
A) datafield array instead of a Range (base data assumed in column A).
B) All found results are written back to a pair of columns that you can change to any other range or a new workbook.
Code
Option Explicit
Sub extract()
' declare and assign variables
Dim header()
header = Array("Amazon emailed seller", "Claim Amount") ' headers
Dim ws As Worksheet ' sheet object (objects have to be SET)
Dim v ' variant datafield array
Dim i As Long, ii As Long, h As Long, n As Long ' counters
Set ws = ThisWorkbook.Worksheets("MySheet") ' << change to your sheet name
n = ws.Range("A" & ws.Rows.Count).End(xlUp).Row ' get last row in column A
' A) create datafield array and loop through items
v = Application.Transpose(ws.Range("A1:B" & n).Value) ' fill 1-based 2-dim datafield array (TWO Columns!)
For i = 1 To n ' loop through array "row"-items
For h = LBound(header) To UBound(header) ' loop through header items
If InStr(v(1, i), header(h)) Then ' check search string against base text
ii = ii + 1 ' increment array counter
v(1, ii) = v(1, i): v(2, ii) = v(1, i + 1) ' enter found values (both rows)
End If
Next h
Next i
ReDim Preserve v(1 To 2, 1 To ii) ' redimension array to actual items count
' -------------------------------------------
' B) Write back results (e.g. in columns D:E) ' << change to ANY wanted pair of columns
' -------------------------------------------
ws.Range("D:E") = "" ' clear columns D:E to get result
ws.Range("D1:E" & ii) = Application.Transpose(v) ' write summary back to columns D:E
' C) Clear memory
Set ws = Nothing
End Sub

Answer 2

This assumes that you know that the text you are looking for will appear somewhere in A1:A20.
=INDEX(A1:A20,MATCH("Claim Amount:",A1:A20,0)+1)
If you do not know which column the text will appear in, you will need to do a match for each possible column OR change your approach (perhaps a helper column).

Answer 3

you could filter all the database in one shot on wanted headers and then get the cells on row below filtered ones
Option Explicit
Sub main()
Dim dataToKeep As Range
Dim headers As Variant
headers = Array("*Amazon emailed seller", "Claim Amount*") 'list your headers (see asterisks for wild characters)
With Worksheets("mySheetName") ' change "mySheetName" to your actual sheet name
With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) 'reference its column A cells from row 1 down to last not empty one
.AutoFilter Field:=1, Criteria1:=headers, Operator:=xlFilterValues ' filter reference cells on wnated headers
If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then Set dataToKeep = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Offset(1) ' if any filtered cell then get their underlying cells
End With
.AutoFilterMode = False
End With
If Not dataToKeep Is Nothing Then
' code to handle all data underlying the searched "header" cells
End If
End Sub