Extracting info from 1 cell to multiple columns

[hnt007]

Hello and thanks for helping me out!

I have a cell containing a lot of info that I need to extract in some columns: First Name (or Pseudo), Middle Name, Last Name, Company, Split, and ID Number. Here is an XL with what I'm trying to achieve: GOAL.xlsx

Sometimes there is no Middle Name, no Last Name, so I'm struggling to find something that works...

 

[DanteAmor]

Run the following macro. Your data in cell A2 and down. The results start in cell B2 onwards.
With the macro it extracts all the names and their corresponding data.

Sub ExtractingInfo()
  Dim a As Variant, b As Variant
  Dim c1, c2, c3, c4, c5, c6
  Dim i As Long, n As Long
  
  a = Range("A2", Range("A" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 6 * 50)
  For i = 1 To UBound(a)
    n = 0
    For Each c1 In Split(a(i, 1), ",")
      n = n + 1
      c2 = Split(Trim(c1), "(")
      c3 = Split(Trim(c2(0)), " ")
      b(i, n) = c3(0)               'First Name
      If UBound(c3) = 1 Then
        b(i, n + 2) = c3(1)         'Last Name
      ElseIf UBound(c3) > 1 Then
        b(i, n + 1) = c3(1)         'Middle Name
        b(i, n + 2) = c3(2)         'Last Name
      End If
      c4 = Split(Trim(c2(1)), ")")
      b(i, n + 3) = c4(0)           'Company
      
      c5 = Split(Trim(c4(1)), "%")
      b(i, n + 4) = c5(0)           'Split
      
      c6 = Replace(Replace(Trim(c5(1)), "[", ""), "]", "")
      b(i, n + 5) = c6              'ID Number
      n = n + 5
    Next
    Range("B2").Resize(UBound(b, 1), n).Value = b
  Next
End Sub

 

[hnt007]

Run the following macro. Your data in cell A2 and down. The results start in cell B2 onwards.
With the macro it extracts all the names and their corresponding data.

Sub ExtractingInfo()
  Dim a As Variant, b As Variant
  Dim c1, c2, c3, c4, c5, c6
  Dim i As Long, n As Long
 
  a = Range("A2", Range("A" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 6 * 50)
  For i = 1 To UBound(a)
    n = 0
    For Each c1 In Split(a(i, 1), ",")
      n = n + 1
      c2 = Split(Trim(c1), "(")
      c3 = Split(Trim(c2(0)), " ")
      b(i, n) = c3(0)               'First Name
      If UBound(c3) = 1 Then
        b(i, n + 2) = c3(1)         'Last Name
      ElseIf UBound(c3) > 1 Then
        b(i, n + 1) = c3(1)         'Middle Name
        b(i, n + 2) = c3(2)         'Last Name
      End If
      c4 = Split(Trim(c2(1)), ")")
      b(i, n + 3) = c4(0)           'Company
    
      c5 = Split(Trim(c4(1)), "%")
      b(i, n + 4) = c5(0)           'Split
    
      c6 = Replace(Replace(Trim(c5(1)), "[", ""), "]", "")
      b(i, n + 5) = c6              'ID Number
      n = n + 5
    Next
    Range("B2").Resize(UBound(b, 1), n).Value = b
  Next
End Sub

Wow this looks really nice but unfortunately I can’t send Excel docs with macros to our 3rd party. Thanks for taking the time to help though, really appreciate it.

 

[DanteAmor]

Okay, let's hope someone helps you with the formulas.