Identifying multiple values from single reoccurring condition in a string

Rav_Singh

New Member
Joined
Jun 29, 2019
Messages
28
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
 
Last edited:

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Maybe
Code:
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
 
Upvote 0
Try this for results starting "B2", based on your Data in column "A" and your "Example" and "Results".
Code:
[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
 
Upvote 0
Maybe
Code:
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...
Code:
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
 
Last edited:
Upvote 0
Here is a macro that does not use any loops that you can consider...
Code:
[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]
 
Upvote 0

Forum statistics

Threads
1,223,904
Messages
6,175,295
Members
452,632
Latest member
jladair

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top