Searching worksheet 1, column A for a value, copying it to worksheet 2 and then copying the next three rows [closed]

I have a 100+ page document containing information on potential funders for our organization. I would like to make an excel macro that extracts contact information from this document and puts it into an Excel spreadsheet. This is what the document looks like:

The addresses are scattered within the text and I've been copying and pasting them into Excel, but since the address is on multiple lines, it pastes into multiple rows of the spreadsheet. I then need to manually parse that string into a usable format.

What I'd like to be able to do is have a macro which searches for the word "Contact" and then takes the next three rows in the same column (hence why VLookUp won't work for me) and parses them into a normal address format in different columns of one row.

"Contact"

VLookUp

I'd like a macro that turns this:

A
1: Contact:
2: Kate Bull
3: 123 High Road, Whetstone, London
4: N20 8HL


Into this:

A B C D E
1: Kate Bull 123 High Street Whetstone London N20 8HL


Please edit the question to limit it to a specific problem with enough detail to identify an adequate answer. Avoid asking multiple distinct questions at once. See the How to Ask page for help clarifying this question. If this question can be reworded to fit the rules in the help center, please edit the question.

1 Answer
1

Seperating your example string by comas will result in 3 strings:

Contact: Kate Bull 123 High Road

Whetstone

London N20 8HL

To implement

A1 = Original String

B1 = Contact

C1 = State

D1 = Country/Zip

A2

Module

Sheet1

Option Explicit

Sub CSV()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim Contact As Range, Contacts As Range, ContactString, i

Set Contacts = ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)

For Each Contact In Contacts
ContactString = Split(Contact, ", ", , vbTextCompare)
For i = LBound(ContactString) To UBound(ContactString)
Contact.Offset(, i + 1) = ContactString(i)
Next i
ContactString = ""
Next Contact

End Sub