Extracting the Required Strings from the Data

Question

I have been trying to create formula to get the required strings from the Data available in Col"A" somehow i managed to create some formulas but that are not efficient and working correctly, they must be dynamic so i would not edit the formula one by one (as i did in my attached sheet).

Data in col"A"

Result i want from data

and here is my try

Any help will be highly appreciated. All the formulas that i have created are available in attached sheet if it can create through VBA then please.

Sheet Link

Tried it with VBA and as well with formula but could not do this.

Sub ReturnString()

Dim ws As Worksheet
Dim val As String
Dim val2 As String
Set ws = Sheet1

val = ws.Range("A2")
val2 = ws.Range("A5")
On Error Resume Next

ws.Range("B28") = Split(val, "(")(0)
ws.Range("C28") = Right(val, Len(val) - (InStrRev(val, "(")))
ws.Range("D28") = Left(val2, Len(val2) - (InStrRev(val2, ":")))
ws.Range("E28") = Left(val2, Len(val2) - (InStrRev(val2, ")")))
End Sub

Formula

=LEFT(A2,(FIND("(",A2,1)-1))
=MID(A2,FIND("(",A2,1)+1,10)
=MID(A5,FIND(":",A5)+1,256)
=MID(A5,FIND("(",A5,1)+1,11)

Answer 1

Basically, you can use the answer from the other question.

What we need to do, is loop it through the data you have. As usual, the exact formatting is important, and there are a few ways to do this.

One way to do it:
First we determine the area we need to look in, then we loop through the column and check criteria. The one I came up with was: "If there's something in the cell, but the previous row was empty, this is a new person".

When this is established, we need to run the formatting. We use the row we have (val), and the row 3 rows down (val2).
But we also need to keep track of where to start printing the information, and to pick the next row on consecutive entries. We use the i variable as a counter.

Sub extract()
Dim ws As Worksheet, workArea As Range, val As Variant, val2 As String, i As Long

Set ws = Worksheets(1)
Set workArea = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
   'Notice that we start at A2, this is both because your data starts there,
   'but also because the below code will throw an error on row 1, since we use .offset(-1)
   'and this is the lazy workaround.

i = 3                                                'row to start printing
For Each val In workArea
    If Len(val) > 0 And Len(val.Offset(-1)) = 0 Then 'look for new entry
        val2 = val.Offset(3)                         'val2 is the Insurance row (3 down)
        
        ws.Range("B" & i) = Split(val, "(")(0)
        ws.Range("C" & i) = Left(Right(val, Len(val) - (InStrRev(val, "("))), 10)
        ws.Range("D" & i) = Mid(val2, InStr(val2, ":") + 2, InStr(val2, "(") - InStr(val2, ":") - 2)
        ws.Range("E" & i) = Mid(val2, InStr(val2, "(") + 1, InStr(val2, ")") - InStr(val2, "(") - 1)
        
        i = i + 1                                    'next entry on next row
    End If
Next val
End Sub