Data stripping, revised:

[Guest]

I have about 300+ data entries in rows like:
Row 1: "Doe, John M. - Company Name"
Row 2: "(555) 555-5555 111 Street"
Row 3: "Anywhere, US"
Row 4 is empty
Row 5 is like Row 1, etc.

What I need is to create another spreadsheet with
Column 1: "Doe"
Column 2: "John"
Column 3: "M"
Column 4: "Company Name"
Column 5: "(555) 555-5555"
Column 6: "111 Street"
Column 7: "Anywhere"
Column 8: "US"

I was thinking at first I might be able to make a macro to separate rows (1
+ 4x, x=1 to 300) into one column of Row X, and rows (2 + 4x, x=1 to 300)
in
another column of Row X, and so on and so forth.

Then, maybe I could condition a macro/script to separate text values
following a comma or space or combination, into other columns.

Not really sure how to execute this. Do you have any advice?

 

[JE McGimpsey]

I have about 300+ data entries in rows like:
Row 1: "Doe, John M. - Company Name"
Row 2: "(555) 555-5555 111 Street"
Row 3: "Anywhere, US"
Row 4 is empty
Row 5 is like Row 1, etc.

What I need is to create another spreadsheet with
Column 1: "Doe"
Column 2: "John"
Column 3: "M"
Column 4: "Company Name"
Column 5: "(555) 555-5555"
Column 6: "111 Street"
Column 7: "Anywhere"
Column 8: "US"

I was thinking at first I might be able to make a macro to separate rows (1
+ 4x, x=1 to 300) into one column of Row X, and rows (2 + 4x, x=1 to 300)
in
another column of Row X, and so on and so forth.

Then, maybe I could condition a macro/script to separate text values
following a comma or space or combination, into other columns.

Not really sure how to execute this. Do you have any advice?

One way:

Public Sub StripData()
Const sQ As String = """"
Dim vRow As Variant
Dim rDest As Range
Dim sTemp As String
Dim nPos As Long
Dim i As Long

Set rDest = Sheets("Sheet2").Range("A1:H1")
With Sheets("Sheet1")
For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row Step 4
ReDim vRow(1 To 8)
sTemp = Trim(Application.Substitute( _
.Cells(i, 1).Text, sQ, ""))
nPos = InStr(sTemp, "-")
If nPos Then
vRow(4) = sQ & Trim(Mid(sTemp, nPos + 1)) & sQ 'Co.
sTemp = Left(sTemp, nPos - 1)
End If
nPos = InStr(sTemp, ",")
vRow(1) = sQ & Left(sTemp, nPos - 1) & sQ 'Last Name
sTemp = Trim(Mid(sTemp, nPos + 1))
nPos = InStr(sTemp, " ")
If nPos Then
vRow(3) = sQ & Mid(sTemp, nPos + 1) & sQ ' M.I.
sTemp = Trim(Left(sTemp, nPos - 1))
Else
vRow(3) = "" ' NMN
End If
vRow(2) = sQ & sTemp & sQ 'First Name
sTemp = Trim(Application.Substitute( _
.Cells(i + 1, 1).Text, sQ, ""))
nPos = InStr(InStr(sTemp, "-"), sTemp, " ")
vRow(5) = sQ & Trim(Left(sTemp, nPos - 1)) & sQ 'Phone
vRow(6) = sQ & Trim(Mid(sTemp, nPos + 1)) & sQ 'Addr
sTemp = Trim(Application.Substitute( _
.Cells(i + 2, 1).Text, sQ, ""))
nPos = InStr(sTemp, ",")
vRow(7) = sQ & Trim(Left(sTemp, nPos - 1)) & sQ 'Anywhere
vRow(8) = sQ & Trim(Mid(sTemp, nPos + 1)) & sQ 'Country
rDest.Value = vRow
Set rDest = rDest.Offset(1, 0).Resize(1, 8)
Erase vRow
Next i
End With
End Sub