Identifying multiple values from single reoccurring condition in a string

[Rav_Singh]

SOS, hoping someone can provide assistance to this challenge I have failed to overcome.

I require to identify specific text nestled between the character 'OR' from a string

Example;

Cell A2 = OR Apprentice OR Assistant OR Professional OR Trainee OR

Answer;

Cell B2 = Apprentice
Cell C2 = Assistant
Cell D2 = Professional
Cell E2 = Trainee

I thought the below VBA code would work but alas the reoccuring 'OR' I suspect is causing the error message for the code below. Any help to fine tune the below code will be gratefully received.

PS> I do not have access to Power Query.
_ _ _

Sub Extract()
Application.ScreenUpdating = False
Dim AR() As Variant: AR = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
Dim SP() As String
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim tmp As String
Dim r As Range

For i = LBound(AR) To UBound(AR)
SP = Split(AR(i, 1), "OR")
For j = 1 To UBound(SP)
tmp = tmp & Left(SP(j), InStr(SP(j), "OR") - 1) & "@"
Next j
AL.Add Left(tmp, Len(tmp) - 1)
tmp = vbNullString
Next i

Set r = Range("B2").Resize(AL.Count, 1)

With r
.Value = Application.Transpose(AL.ToArray)
.TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="@"
End With

Application.ScreenUpdating = True
End Sub

 

[Fluff]

Maybe

Sub RavSingh()
   Dim Cl As Range
   
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Cl.Offset(, 1).Resize(, UBound(Split(Cl, "OR "))).Value = Split(Cl, "OR ")
   Next Cl
End Sub

 

[MickG]

Try this for results starting "B2", based on your Data in column "A" and your "Example" and "Results".

[COLOR="Navy"]Sub[/COLOR] MG08Aug26
[COLOR="Navy"]Dim[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    c = 0
    Sp = Split(Dn.Value, "OR")
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
            [COLOR="Navy"]If[/COLOR] Sp(n) <> "" [COLOR="Navy"]Then[/COLOR]
                c = c + 1
                Dn.Offset(, c) = Trim(Sp(n))
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Rick Rothstein]

Maybe

Sub RavSingh()
   Dim Cl As Range
   
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Cl.Offset(, 1).Resize(, UBound(Split(Cl, "OR "))).Value = Split(Cl, "OR ")
   Next Cl
End Sub

Your code does not work correctly... it starts in cell C2 (not B2), omits the last item in the list and retains the trailing space (the one before the OR) on each outputted item. Assuming the internal OR's are always surrounded by spaces and the the first OR always has a space after it and that the last OR always has a space before it, the fix is "relatively" easy...

Sub RavSingh2()
   Dim Cl As Range
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      Cl.Offset(, 1).Resize(, UBound(Split(Cl, "OR "))).Value = Split(Mid(" " & Cl & " ", 5), " OR ")
   Next Cl
End Sub

 

[Rick Rothstein]

Here is a macro that does not use any loops that you can consider...

[table="width: 500"]
[tr]
	[td]Sub RavSingh3()
  Application.ScreenUpdating = False
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Offset(, 1).Value = Evaluate("IF({1},MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(" & .Address & ",""OR"",""|""),""| "",""|""),"" |"",""|""),2,300))")
    .Offset(, 1).TextToColumns , xlDelimited, , , False, False, False, False, True, "|"
  End With
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[Rav_Singh]

Thank you all. Always humbled by the help on here.

Solution found.

 

[MickG]

You're welcome