Is there a VBA code using REGEX to help me delimit the 2 rightmost "*" under certain conditions?

[EmilyCrandall]

Emilia*Grace Johnson*IT0037201X*23
Megan*2 Richards*PE018187
Isabel Sneider*TEC017106S*43
Isaiah Lee*TEC017102X
Billy*Bob*3 Joel*TBF016052H*35


Is there a VBA Code using REGEX to delimit the employee ID and age at the end of the line using the "*"?

Some of my rows have up to 4 "*" (used for hyphenated names and/or the amount of positions worked) but I only want the employee ID and age to be delimited. Some rows don't have an age either.

(If it helps, the ages will always only be 2 digits)

Any ideas would help greatly.

 

[Fluff]

If you want to delete the original data, have you tried the macro that Eric posted?

 

[EmilyCrandall]

If you want to delete the original data, have you tried the macro that Eric posted?

Unfortunately,

If Len(w(u)) = 2 Then

was "out of range". I toggled with it a little bit, but I am very new to VBA so I didn't find a solution yet.

 

[JEC]

I came up with almost the same macro as Eric by coincidence
Not completely the same though

Sub jec()
 Dim ar, a, y, i As Long
 ar = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
 
 For i = 1 To UBound(ar)
   a = Split(ar(i, 1), "*")
   y = UBound(a)
   If IsNumeric(a(y)) Then
     ar(i, 1) = a(y - 1)
     ar(i, 2) = a(y)
   Else
     ar(i, 1) = a(y)
   End If
 Next
  
 Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 2) = ar
End Sub

 

[Fluff]

was "out of range"

It would have helped if you had mentioned that, otherwise Eric wouldn't know.

 

[EmilyCrandall]

I came up with almost the same macro as Eric by coincidence
Not completely the same though

Sub jec()
 Dim ar, a, y, i As Long
 ar = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
 
 For i = 1 To UBound(ar)
   a = Split(ar(i, 1), "*")
   y = UBound(a)
   If IsNumeric(a(y)) Then
     ar(i, 1) = a(y - 1)
     ar(i, 2) = a(y)
   Else
     ar(i, 1) = a(y)
   End If
 Next
 
 Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 2) = ar
End Sub

This one runs! but now it is deleting the name from the original cell. You are left with only two cells (the ID and age), rather than 3 separate cells. I'm sorry I don't think I explained it well.

 

[JEC]

Ok, and now?

Sub jec()
 Dim ar, a, y, i As Long
 ar = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
 
 For i = 1 To UBound(ar)
   a = Split(ar(i, 1), "*")
   y = UBound(a)
   If IsNumeric(a(y)) Then
     ar(i, 2) = a(y - 1)
     ar(i, 3) = a(y)
   Else
     ar(i, 2) = a(y)
   End If
 Next
   
 Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3) = ar
End Sub

 

[EmilyCrandall]

Ok, and now?

Sub jec()
 Dim ar, a, y, i As Long
 ar = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
 
 For i = 1 To UBound(ar)
   a = Split(ar(i, 1), "*")
   y = UBound(a)
   If IsNumeric(a(y)) Then
     ar(i, 2) = a(y - 1)
     ar(i, 3) = a(y)
   Else
     ar(i, 2) = a(y)
   End If
 Next
  
 Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3) = ar
End Sub

Yes! This one runs and keeps all the data! Can I add a step to delete the ID and age from the name cell? So the original is now just the name.

I attached an image: the first row is what the macro result is, the second row is the objective in theory.

 

[JEC]

Ok how about

Sub jec()
 Dim ar, a, y, i As Long
 ar = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
 
 For i = 1 To UBound(ar)
   a = Split(ar(i, 1), "*")
   y = UBound(a)
   If IsNumeric(a(y)) Then
     ar(i, 2) = a(y - 1)
     ar(i, 3) = a(y)
     ar(i, 1) = Join(Filter(Filter(a, a(y - 1), 0), a(y), 0))
   Else
     ar(i, 2) = a(y)
     ar(i, 1) = Join(Filter(a, a(y), 0))
   End If
 Next
   
 Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3) = ar
End Sub

 

[EmilyCrandall]

Ok how about

Sub jec()
 Dim ar, a, y, i As Long
 ar = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
 
 For i = 1 To UBound(ar)
   a = Split(ar(i, 1), "*")
   y = UBound(a)
   If IsNumeric(a(y)) Then
     ar(i, 2) = a(y - 1)
     ar(i, 3) = a(y)
     ar(i, 1) = Join(Filter(Filter(a, a(y - 1), 0), a(y), 0))
   Else
     ar(i, 2) = a(y)
     ar(i, 1) = Join(Filter(a, a(y), 0))
   End If
 Next
  
 Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3) = ar
End Sub

YES! This is exactly it, thank you for your patience! This is my first time using VBA and (honestly Excel for anything more than a basic table So you can say I am definitely learning. I really appreciate your help.

 

[JEC]

You're welcome! Good luck learning